TADPOLE_BSWiMS

1 TADPOLE and BSWiMS

1.0.1 Loading the libraries

library("FRESA.CAD")
library(readxl)
library(igraph)
op <- par(no.readonly = TRUE)
pander::panderOptions('digits', 3)
pander::panderOptions('table.split.table', 400)
pander::panderOptions('keep.trailing.zeros',TRUE)

1.1 The data set

TADPOLE_D1_D2 <- read.csv("~/GitHub/BSWiMS/Data/TADPOLE/TADPOLE_D1_D2.csv")
TADPOLE_D1_D2_Dict <- read.csv("~/GitHub/BSWiMS/Data/TADPOLE/TADPOLE_D1_D2_Dict.csv")
TADPOLE_D1_D2_Dict_LR <- as.data.frame(read_excel("~/GitHub/BSWiMS/Data/TADPOLE/TADPOLE_D1_D2_Dict_LR.xlsx",sheet = "LeftRightFeatures"))


rownames(TADPOLE_D1_D2_Dict) <- TADPOLE_D1_D2_Dict$FLDNAME

1.2 Conditioning the data

# mm3 to mm
isVolume <- c("Ventricles","Hippocampus","WholeBrain","Entorhinal","Fusiform","MidTemp","ICV",
              TADPOLE_D1_D2_Dict$FLDNAME[str_detect(TADPOLE_D1_D2_Dict$TEXT,"Volume")]
              )


#TADPOLE_D1_D2[,isVolume] <- apply(TADPOLE_D1_D2[,isVolume],2,'^',(1/3))
TADPOLE_D1_D2[,isVolume] <- TADPOLE_D1_D2[,isVolume]^(1/3)

# mm2 to mm
isArea <- TADPOLE_D1_D2_Dict$FLDNAME[str_detect(TADPOLE_D1_D2_Dict$TEXT,"Area")]
TADPOLE_D1_D2[,isArea] <- sqrt(TADPOLE_D1_D2[,isArea])

# Get only cross sectional measurements
FreeSurfersetCross <- str_detect(colnames(TADPOLE_D1_D2),"UCSFFSX")

# The subset of baseline measurements
baselineTadpole <- subset(TADPOLE_D1_D2,VISCODE=="bl")
table(baselineTadpole$DX)

                   Dementia Dementia to MCI             MCI MCI to Dementia 
          7             336               1             864               5 
  MCI to NL              NL       NL to MCI 
          2             521               1 

rownames(baselineTadpole) <- baselineTadpole$PTID


validBaselineTadpole <- cbind(DX=baselineTadpole$DX,
                                 AGE=baselineTadpole$AGE,
                                 Gender=1*(baselineTadpole$PTGENDER=="Female"),
                                 ADAS11=baselineTadpole$ADAS11,
                                 ADAS13=baselineTadpole$ADAS13,
                                 MMSE=baselineTadpole$MMSE,
                                 RAVLT_immediate=baselineTadpole$RAVLT_immediate,
                                 RAVLT_learning=baselineTadpole$RAVLT_learning,
                                 RAVLT_forgetting=baselineTadpole$RAVLT_forgetting,
                                 RAVLT_perc_forgetting=baselineTadpole$RAVLT_perc_forgetting,
                                 FAQ=baselineTadpole$FAQ,
                                 Ventricles=baselineTadpole$Ventricles,
                                 Hippocampus=baselineTadpole$Hippocampus,
                                 WholeBrain=baselineTadpole$WholeBrain,
                                 Entorhinal=baselineTadpole$Entorhinal,
                                 Fusiform=baselineTadpole$Fusiform,
                                 MidTemp=baselineTadpole$MidTemp,
                                 ICV=baselineTadpole$ICV,
                                 baselineTadpole[,FreeSurfersetCross])


LeftFields <- TADPOLE_D1_D2_Dict_LR$LFN
names(LeftFields) <- LeftFields
LeftFields <- LeftFields[LeftFields %in% colnames(validBaselineTadpole)]
RightFields <- TADPOLE_D1_D2_Dict_LR$RFN
names(RightFields) <- RightFields
RightFields <- RightFields[RightFields %in% colnames(validBaselineTadpole)]

## Normalize to ICV
validBaselineTadpole$Ventricles=validBaselineTadpole$Ventricles/validBaselineTadpole$ICV
validBaselineTadpole$Hippocampus=validBaselineTadpole$Hippocampus/validBaselineTadpole$ICV
validBaselineTadpole$WholeBrain=validBaselineTadpole$WholeBrain/validBaselineTadpole$ICV
validBaselineTadpole$Entorhinal=validBaselineTadpole$Entorhinal/validBaselineTadpole$ICV
validBaselineTadpole$Fusiform=validBaselineTadpole$Fusiform/validBaselineTadpole$ICV
validBaselineTadpole$MidTemp=validBaselineTadpole$MidTemp/validBaselineTadpole$ICV

leftData <- validBaselineTadpole[,LeftFields]/validBaselineTadpole$ICV
RightData <- validBaselineTadpole[,RightFields]/validBaselineTadpole$ICV

## get mean and relative difference 
meanLeftRight <- (leftData + RightData)/2
difLeftRight <- abs(leftData - RightData)
reldifLeftRight <- difLeftRight/meanLeftRight
colnames(meanLeftRight) <- paste("M",colnames(meanLeftRight),sep="_")
colnames(difLeftRight) <- paste("D",colnames(difLeftRight),sep="_")
colnames(reldifLeftRight) <- paste("RD",colnames(reldifLeftRight),sep="_")


validBaselineTadpole <- validBaselineTadpole[,!(colnames(validBaselineTadpole) %in% 
                                               c(LeftFields,RightFields))]
validBaselineTadpole <- cbind(validBaselineTadpole,meanLeftRight,reldifLeftRight)

## Remove columns with too many NA more than %15 of NA
nacount <- apply(is.na(validBaselineTadpole),2,sum)/nrow(validBaselineTadpole) < 0.15
diagnose <- validBaselineTadpole$DX
pander::pander(table(diagnose))

	Dementia	Dementia to MCI	MCI	MCI to Dementia	MCI to NL	NL	NL to MCI
7	336	1	864	5	2	521	1

validBaselineTadpole <- validBaselineTadpole[,nacount]
## Remove character columns
ischar <- sapply(validBaselineTadpole,class) == "character"
validBaselineTadpole <- validBaselineTadpole[,!ischar]
## Place back diagnose
validBaselineTadpole$DX <- diagnose


validBaselineTadpole <- validBaselineTadpole[complete.cases(validBaselineTadpole),]
ischar <- sapply(validBaselineTadpole,class) == "character"
validBaselineTadpole[,!ischar] <- sapply(validBaselineTadpole[,!ischar],as.numeric)

colnames(validBaselineTadpole) <- str_remove_all(colnames(validBaselineTadpole),"_UCSFFSX_11_02_15_UCSFFSX51_08_01_16")
colnames(validBaselineTadpole) <- str_replace_all(colnames(validBaselineTadpole)," ","_")
validBaselineTadpole$LONISID <- NULL
validBaselineTadpole$IMAGEUID <- NULL
validBaselineTadpole$LONIUID <- NULL

diagnose <- as.character(validBaselineTadpole$DX)
validBaselineTadpole$DX <- diagnose
pander::pander(table(validBaselineTadpole$DX))

Dementia	Dementia to MCI	MCI	MCI to Dementia	MCI to NL	NL	NL to MCI
244	1	711	2	2	452	1

validDX <- c("NL","MCI","Dementia")

validBaselineTadpole <- validBaselineTadpole[validBaselineTadpole$DX %in% validDX,]
validBaselineTadpole$DX <- as.factor(validBaselineTadpole$DX)
pander::pander(table(validBaselineTadpole$DX))

Dementia	MCI	NL
244	711	452

1.3 Get the Time To Event on MCI Subjects

subjectsID <- rownames(validBaselineTadpole)
visitsID <- unique(TADPOLE_D1_D2$VISCODE)
baseDx <- TADPOLE_D1_D2[TADPOLE_D1_D2$VISCODE=="bl",c("PTID","DX","EXAMDATE")]
rownames(baseDx) <- baseDx$PTID 
baseDx <- baseDx[subjectsID,]
lastDx <- baseDx
toDementia <- baseDx
table(lastDx$DX)

Dementia MCI NL 244 711 452

hasDementia <- lastDx$PTID[str_detect(lastDx$DX,"Dementia")]


for (vid in visitsID)
{
  DxValue <- TADPOLE_D1_D2[TADPOLE_D1_D2$VISCODE==vid,c("PTID","DX","EXAMDATE")]
  rownames(DxValue) <- DxValue$PTID 
  DxValue <- DxValue[DxValue$PTID %in% subjectsID,]
  noDX <- DxValue$PTID[nchar(DxValue$DX) < 1]
  print(length(noDX))
  DxValue[noDX,] <- lastDx[noDX,]
  inLast <- lastDx$PTID[lastDx$PTID %in% DxValue$PTID]
  print(length(inLast))
  lastDx[inLast,] <- DxValue[inLast,]
  noDementia <- !(toDementia$PTID %in% hasDementia)
  toDementia[noDementia,] <- lastDx[noDementia,]
  hasDementia <- unique(c(hasDementia,lastDx$PTID[str_detect(lastDx$DX,"Dementia")]))
}

[1] 0 [1] 1407 [1] 2 [1] 1320 [1] 6 [1] 1212 [1] 23 [1] 1090 [1] 802 [1] 1054 [1] 29 [1] 706 [1] 20 [1] 212 [1] 14 [1] 167 [1] 32 [1] 551 [1] 25 [1] 297 [1] 18 [1] 130 [1] 665 [1] 665 [1] 112 [1] 112 [1] 176 [1] 176 [1] 177 [1] 177 [1] 624 [1] 624 [1] 251 [1] 251 [1] 159 [1] 159 [1] 7 [1] 7 [1] 17 [1] 99 [1] 9 [1] 63 [1] 1 [1] 1

table(lastDx$DX)

   Dementia Dementia to MCI             MCI MCI to Dementia       MCI to NL 
        426               2             460              80               7 
         NL  NL to Dementia       NL to MCI 
        405               1              26 

baseMCI <-baseDx$PTID[baseDx$DX == "MCI"]
lastDementia <- lastDx$PTID[str_detect(lastDx$DX,"Dementia")]
lastDementia2 <- toDementia$PTID[str_detect(toDementia$DX,"Dementia")]
lastNL <- lastDx$PTID[str_detect(lastDx$DX,"NL")]

MCIatBaseline <- baseDx[baseMCI,]
MCIatEvent <- toDementia[baseMCI,]
MCIatLast <- lastDx[baseMCI,]

MCIconverters <- MCIatBaseline[baseMCI %in% lastDementia,]
MCI_No_converters <- MCIatBaseline[!(baseMCI %in% MCIconverters$PTID),]
MCIconverters$TimeToEvent <- (as.Date(toDementia[MCIconverters$PTID,"EXAMDATE"]) 
                                   - as.Date(MCIconverters$EXAMDATE))

sum(MCIconverters$TimeToEvent ==0)

[1] 0

MCIconverters$AtEventDX <- MCIatEvent[MCIconverters$PTID,"DX"]
MCIconverters$LastDX <- MCIatLast[MCIconverters$PTID,"DX"]

MCI_No_converters$TimeToEvent <- (as.Date(lastDx[MCI_No_converters$PTID,"EXAMDATE"]) 
                                   - as.Date(MCI_No_converters$EXAMDATE))

MCI_No_converters$LastDX <- MCIatLast[MCI_No_converters$PTID,"DX"]

MCI_No_converters <- subset(MCI_No_converters,TimeToEvent > 0)

1.3.1 Correlation Matrix Data

The heat map of the testing set.

cormat <- cor(validBaselineTadpole[,colnames(validBaselineTadpole) != "DX"],method="spearman")
diag(cormat) <- 0;
corrmax <- apply(cormat,2,max)
whomax <- colnames(cormat)[corrmax>0.75]
gplots::heatmap.2(abs(cormat[whomax,whomax]),
                  trace = "none",
                  scale = "none",
                  mar = c(10,10),
                  col=rev(heat.colors(5)),
                  main = "Baseline TADPOLE Correlation",
                  cexRow = 0.5,
                  cexCol = 0.5,
                  key.title=NA,
                  key.xlab="Spearman Correlation",
                  xlab="Feature", ylab="Feature")

par(op)

2 Predicting ADAS13

Here we will diagnose ADAS13

2.1 Training and testing sets

TrainFraction <- 0.5;

TADPOLECrossMRI <- validBaselineTadpole
summary(TADPOLECrossMRI$ADAS13)

Min. 1st Qu. Median Mean 3rd Qu. Max. 0.00 9.00 14.67 16.37 22.00 51.00

TADPOLECrossMRI$ADAS11 <- NULL
TADPOLECrossMRI$MMSE <- NULL
TADPOLECrossMRI$RAVLT_immediate <- NULL
TADPOLECrossMRI$RAVLT_learning <- NULL
TADPOLECrossMRI$RAVLT_perc_forgetting <- NULL
TADPOLECrossMRI$RAVLT_forgetting <- NULL
TADPOLECrossMRI$FAQ <- NULL
TADPOLECrossMRI$DX <- NULL

trainSet <- sample(nrow(TADPOLECrossMRI),nrow(TADPOLECrossMRI)*TrainFraction)

TADPOLECrossMRITrain <- TADPOLECrossMRI[trainSet,]
TADPOLECrossMRITest <- TADPOLECrossMRI[-trainSet,]

2.1.1 Learning ADAS13

bml <- BSWiMS.model(ADAS13~.,TADPOLECrossMRITrain,maxTrainModelSize=50,NumberofRepeats = 20)

[++-+–+-++-++-+-+-+–++-++-+-++-+-+++-++-+-+-++-+-+-]…

pander::pander(bml$bagging$Jaccard.SM)

0.299

fs <- bml$bagging$frequencyTable
barplot(fs[order(-fs)],las=2,main="Selected Features",cex.names = 0.5)

sm <- summary(bml)
pander::pander(sm$coefficients)

	Estimate	lower	mean	upper	u.MSE	r.MSE	model.MSE	NeRI	F.pvalue	t.pvalue	Sign.pvalue	Wilcox.pvalue	Frequency
M_ST40TA	-135.0232	-164.312	-135.0232	-105.7341	64.3	53.2	48.9	0.0820	0.00e+00	1.79e-06	0.01401	0.000785	0.15
M_ST24CV	-75.3109	-99.777	-75.3109	-50.8450	60.8	47.0	44.6	0.0561	8.04e-10	1.23e-05	0.04898	0.001946	0.45
RD_ST32TA	21.8615	14.440	21.8615	29.2831	75.0	43.4	41.4	0.0064	3.88e-09	1.39e-02	0.48410	0.147555	1.00
Hippocampus	-161.7606	-216.992	-161.7606	-106.5289	58.6	43.4	41.4	0.0745	4.73e-09	7.64e-04	0.02399	0.009590	1.00
M_ST24TA	-338.3565	-456.667	-338.3565	-220.0458	56.7	43.3	41.4	0.0886	1.04e-08	1.07e-05	0.00874	0.001001	1.00
M_ST56TS	1873.9196	1182.131	1873.9196	2565.7081	81.3	43.1	41.4	0.0558	5.51e-08	7.43e-04	0.06147	0.015960	1.00
M_ST60SA	37.1529	22.451	37.1529	51.8548	83.0	45.5	44.0	0.0420	3.65e-07	9.07e-03	0.12496	0.066805	0.55
M_ST54TS	89.5081	53.603	89.5081	125.4126	81.6	53.1	51.2	0.0555	5.14e-07	1.07e-01	0.06244	0.168719	0.10
M_ST12SV	-82.8267	-117.084	-82.8267	-48.5698	61.0	46.0	44.6	0.0684	1.07e-06	1.55e-03	0.02901	0.018707	0.45
M_ST39CV	57.2308	33.238	57.2308	81.2234	80.0	42.2	40.9	0.0430	1.47e-06	4.18e-03	0.11676	0.048345	0.40
M_ST52TA	-360.3237	-511.408	-360.3237	-209.2389	71.4	43.5	42.2	0.0606	1.47e-06	3.19e-03	0.05055	0.020820	0.55
M_ST31CV	-35.1903	-50.685	-35.1903	-19.6953	68.0	43.7	42.5	0.0441	4.27e-06	4.40e-03	0.09825	0.024367	0.40
M_ST62TA	233.7800	130.465	233.7800	337.0950	81.3	42.9	41.7	0.0353	4.60e-06	4.52e-02	0.15638	0.145967	0.55
M_ST47TS	522.6854	290.780	522.6854	754.5905	82.0	45.8	44.5	0.0629	4.99e-06	7.50e-04	0.04675	0.009359	0.40
RD_ST40CV	12.5238	6.621	12.5238	18.4264	77.1	44.2	43.1	0.0235	1.60e-05	5.58e-02	0.24577	0.126048	0.65
RD_ST31TA	19.3108	10.034	19.3108	28.5872	78.1	42.4	41.4	0.0583	2.25e-05	7.87e-03	0.05931	0.063638	1.00
M_ST57TA	-79.8265	-118.438	-79.8265	-41.2148	73.9	42.5	41.5	0.0327	2.54e-05	3.99e-02	0.20215	0.179564	0.15
M_ST32CV	-14.5650	-21.739	-14.5650	-7.3907	65.5	45.7	44.7	0.0223	3.46e-05	5.56e-02	0.28634	0.167421	0.15
M_ST55CV	-55.4271	-82.734	-55.4271	-28.1204	72.9	43.9	42.9	0.0509	3.47e-05	9.44e-03	0.08908	0.067193	0.50
M_ST30SV	48.4884	23.728	48.4884	73.2491	62.1	42.8	41.9	0.0504	6.20e-05	1.74e-03	0.08333	0.017938	0.90
RD_ST40TA	3.4142	1.621	3.4142	5.2078	74.3	45.4	44.5	0.0316	9.54e-05	6.37e-02	0.20165	0.169337	0.25
M_ST40CV	-61.6334	-94.073	-61.6334	-29.1935	63.7	42.9	42.0	0.0314	9.81e-05	7.31e-02	0.21204	0.121611	0.65
M_ST60CV	19.0522	8.790	19.0522	29.3144	76.6	41.8	41.0	0.0327	1.37e-04	3.42e-02	0.20305	0.108577	0.15
M_ST13SA	-4.1309	-6.358	-4.1309	-1.9039	79.5	42.3	41.5	0.0441	1.39e-04	2.55e-01	0.12625	0.171488	0.10
M_ST65SV	36.5800	16.835	36.5800	56.3250	81.3	42.7	41.9	0.0377	1.41e-04	3.61e-02	0.13739	0.088187	0.20
M_ST17SV	18.1184	8.030	18.1184	28.2070	83.8	43.8	43.0	0.0597	2.16e-04	2.93e-03	0.05780	0.023159	0.30
AGE	-0.0289	-0.045	-0.0289	-0.0127	81.9	42.5	41.8	0.0356	2.29e-04	3.02e-03	0.16288	0.037139	0.30
RD_ST47TS	-1.8704	-2.938	-1.8704	-0.8028	82.9	45.5	44.8	0.0427	2.98e-04	3.75e-03	0.12913	0.073220	0.20
RD_ST52TA	1.7988	0.727	1.7988	2.8706	79.8	45.7	45.0	0.0299	5.02e-04	6.11e-03	0.22485	0.031818	0.10
RD_ST56TA	7.4024	2.507	7.4024	12.2982	81.9	45.0	44.5	0.0445	1.52e-03	7.59e-02	0.11513	0.193209	0.35
Ventricles	-5.8305	-9.906	-5.8305	-1.7549	74.5	43.3	42.8	0.0200	2.52e-03	2.12e-02	0.28810	0.089125	0.65
M_ST24TS	59.2762	17.626	59.2762	100.9265	79.4	51.3	50.7	0.0541	2.64e-03	5.27e-03	0.06847	0.022925	0.10

pander::pander(bml$univariate[bml$selectedfeatures,])

	Name	RName	ZUni
M_ST24TA	M_ST24TA	M_ST24TA	Inf
RD_ST32TA	RD_ST32TA	RD_ST32TA	Inf
Hippocampus	Hippocampus	Hippocampus	Inf
RD_ST31TA	RD_ST31TA	RD_ST31TA	7.19
M_ST56TS	M_ST56TS	M_ST56TS	4.85
M_ST30SV	M_ST30SV	M_ST30SV	Inf
Ventricles	Ventricles	Ventricles	Inf
M_ST13SA	M_ST13SA	M_ST13SA	6.27
M_ST40CV	M_ST40CV	M_ST40CV	Inf
ST68SV	ST68SV	ST68SV	4.78
AGE	AGE	AGE	4.30
M_ST57TA	M_ST57TA	M_ST57TA	Inf
M_ST39CV	M_ST39CV	M_ST39CV	5.90
M_ST62TA	M_ST62TA	M_ST62TA	4.83
M_ST60CV	M_ST60CV	M_ST60CV	8.13
M_ST55SA	M_ST55SA	M_ST55SA	5.22
M_ST24CV	M_ST24CV	M_ST24CV	Inf
M_ST31CV	M_ST31CV	M_ST31CV	Inf
M_ST52TA	M_ST52TA	M_ST52TA	Inf
RD_ST40CV	RD_ST40CV	RD_ST40CV	7.82
M_ST55CV	M_ST55CV	M_ST55CV	Inf
M_ST65SV	M_ST65SV	M_ST65SV	4.91
RD_ST47TS	RD_ST47TS	RD_ST47TS	3.14
M_ST12SV	M_ST12SV	M_ST12SV	Inf
M_ST32CV	M_ST32CV	M_ST32CV	Inf
M_ST17SV	M_ST17SV	M_ST17SV	1.60
RD_ST40TA	RD_ST40TA	RD_ST40TA	Inf
RD_ST56TA	RD_ST56TA	RD_ST56TA	4.31
M_ST60SA	M_ST60SA	M_ST60SA	3.03
RD_ST52TA	RD_ST52TA	RD_ST52TA	6.05
M_ST47TS	M_ST47TS	M_ST47TS	4.16
M_ST40TA	M_ST40TA	M_ST40TA	Inf
M_ST13TS	M_ST13TS	M_ST13TS	6.31
M_ST60TA	M_ST60TA	M_ST60TA	Inf
M_ST24TS	M_ST24TS	M_ST24TS	6.37
RD_ST29SV	RD_ST29SV	RD_ST29SV	7.10
M_ST54TS	M_ST54TS	M_ST54TS	4.63
RD_ST52CV	RD_ST52CV	RD_ST52CV	4.62
RD_ST24TA	RD_ST24TA	RD_ST24TA	8.21
M_ST32SA	M_ST32SA	M_ST32SA	7.68
M_ST36TS	M_ST36TS	M_ST36TS	1.09
M_ST47TA	M_ST47TA	M_ST47TA	6.14

prreg <- predictionStats_regression(cbind(TADPOLECrossMRITest$ADAS13,predict(bml,TADPOLECrossMRITest)),"ADAS13")

ADAS13

pander::pander(prreg)

• corci:

  cor
  0.707	0.668	0.742

• biasci: -0.261, -0.774 and 0.252

• RMSEci: 6.94, 6.59 and 7.32

• spearmanci:

  50%	2.5%	97.5%
  0.672	0.626	0.713

• MAEci:

  50%	2.5%	97.5%
  5.4	5.09	5.72

• pearson:

  Pearson’s product-moment correlation: predictions[, 1] and predictions[, 2]

  Test statistic	df	P value	Alternative hypothesis	cor
  26.5	702	1.37e-107 * * *	two.sided	0.707

par(op)

2.1.2 The formula network

cmax <- apply(bml$bagging$formulaNetwork,2,max)
cnames <- names(cmax[cmax>=0.250])
cmax <- cmax[cnames]

adma <- bml$bagging$formulaNetwork[cnames,cnames]

adma[adma<0.15] <- 0;
gr <- graph_from_adjacency_matrix(adma,mode = "undirected",diag = FALSE,weighted=TRUE)
gr$layout <- layout_with_fr

fc <- cluster_optimal(gr)
plot(fc, gr,
     edge.width=5*E(gr)$weight,
     vertex.size=20*cmax,
     vertex.label.cex=0.5,
     vertex.label.dist=0,
     main="ADAS13 Feature Association")

par(op)

2.1.3 The ADAS13 table

clusterFeatures <- fc$names
sm$coefficients$Rx2 <- (sm$coefficients$r.MSE-sm$coefficients$model.MSE)/sm$coefficients$r.MSE

tableADAS13 <- sm$coefficients[clusterFeatures,
                                   c("Estimate",
                                     "lower",
                                     "mean",
                                     "upper",
                                     "model.MSE",
                                     "Rx2",
                                     "F.pvalue",
                                     "Frequency")]

nugget <- fc$membership
names(nugget) <- clusterFeatures

tableADAS13$Cluster <- nugget[rownames(tableADAS13)]

rnames <- clusterFeatures[str_detect(clusterFeatures,"ST")]
frnames <- rnames
rnames <- str_replace_all(rnames,"M_","")
rnames <- str_replace_all(rnames,"RD_","")
description <- character()

for (ddet in c(1:length(rnames)))
{
  description <- c(description,TADPOLE_D1_D2_Dict$TEXT[str_detect(TADPOLE_D1_D2_Dict$FLDNAME,rnames[ddet])][1])
}
names(description) <- frnames

tableADAS13$Description <- description[rownames(tableADAS13)]
pander::pander(tableADAS13)

	Estimate	lower	mean	upper	model.MSE	Rx2	F.pvalue	Frequency	Cluster	Description
M_ST24TA	-338.3565	-456.667	-338.3565	-220.0458	41.4	0.0438	1.04e-08	1.00	1	Cortical Thickness Average of LeftEntorhinal
RD_ST32TA	21.8615	14.440	21.8615	29.2831	41.4	0.0464	3.88e-09	1.00	1	Cortical Thickness Average of LeftInferiorTemporal
Hippocampus	-161.7606	-216.992	-161.7606	-106.5289	41.4	0.0459	4.73e-09	1.00	1	NA
RD_ST31TA	19.3108	10.034	19.3108	28.5872	41.4	0.0235	2.25e-05	1.00	1	Cortical Thickness Average of LeftInferiorParietal
M_ST56TS	1873.9196	1182.131	1873.9196	2565.7081	41.4	0.0395	5.51e-08	1.00	1	Cortical Thickness Standard Deviation of LeftSuperiorFrontal
M_ST30SV	48.4884	23.728	48.4884	73.2491	41.9	0.0213	6.20e-05	0.90	1	Volume (WM Parcellation) of LeftInferiorLateralVentricle
Ventricles	-5.8305	-9.906	-5.8305	-1.7549	42.8	0.0111	2.52e-03	0.65	2	NA
M_ST40CV	-61.6334	-94.073	-61.6334	-29.1935	42.0	0.0197	9.81e-05	0.65	1	Volume (Cortical Parcellation) of LeftMiddleTemporal
AGE	-0.0289	-0.045	-0.0289	-0.0127	41.8	0.0174	2.29e-04	0.30	1	NA
M_ST39CV	57.2308	33.238	57.2308	81.2234	40.9	0.0307	1.47e-06	0.40	1	Volume (Cortical Parcellation) of LeftMedialOrbitofrontal
M_ST62TA	233.7800	130.465	233.7800	337.0950	41.7	0.0275	4.60e-06	0.55	1	Cortical Thickness Average of LeftTransverseTemporal
M_ST24CV	-75.3109	-99.777	-75.3109	-50.8450	44.6	0.0507	8.04e-10	0.45	2	Volume (Cortical Parcellation) of LeftEntorhinal
M_ST31CV	-35.1903	-50.685	-35.1903	-19.6953	42.5	0.0281	4.27e-06	0.40	2	Volume (Cortical Parcellation) of LeftInferiorParietal
M_ST52TA	-360.3237	-511.408	-360.3237	-209.2389	42.2	0.0307	1.47e-06	0.55	1	Cortical Thickness Average of LeftPrecuneus
RD_ST40CV	12.5238	6.621	12.5238	18.4264	43.1	0.0247	1.60e-05	0.65	2	Volume (Cortical Parcellation) of LeftMiddleTemporal
M_ST55CV	-55.4271	-82.734	-55.4271	-28.1204	42.9	0.0226	3.47e-05	0.50	1	Volume (Cortical Parcellation) of LeftRostralMiddleFrontal
M_ST12SV	-82.8267	-117.084	-82.8267	-48.5698	44.6	0.0315	1.07e-06	0.45	2	Volume (WM Parcellation) of LeftAmygdala
M_ST17SV	18.1184	8.030	18.1184	28.2070	43.0	0.0175	2.16e-04	0.30	2	Volume (WM Parcellation) of LeftCerebellumCortex
RD_ST40TA	3.4142	1.621	3.4142	5.2078	44.5	0.0199	9.54e-05	0.25	2	Cortical Thickness Average of LeftMiddleTemporal
RD_ST56TA	7.4024	2.507	7.4024	12.2982	44.5	0.0124	1.52e-03	0.35	2	Cortical Thickness Average of LeftSuperiorFrontal
M_ST60SA	37.1529	22.451	37.1529	51.8548	44.0	0.0346	3.65e-07	0.55	2	Surface Area of LeftTemporalPole
M_ST47TS	522.6854	290.780	522.6854	754.5905	44.5	0.0276	4.99e-06	0.40	2	Cortical Thickness Standard Deviation of LeftParsTriangularis

2.1.4 Decorrelating training and testing sets

TADPOLECrossMRITrainD <- GDSTMDecorrelation(TADPOLECrossMRITrain,Outcome="ADAS13",
                                        thr=0.6,
                                        type="RLM",
                                        method="spearman",
                                        verbose = TRUE)
#> 
#>  Included: 204 , Uni p: 0.01148552 To Outcome: 132 , Base: 7 , In Included: 7 , Base Cor: 18 
#> 1 , Top: 40 < 0.6 >( 2 )[ 1 : 0 : 0.594 ]( 39 , 95 , 0 ),<>Tot Used: 134 , Added: 95 , Zero Std: 0 , Max Cor: 0.9558371 
#> 2 , Top: 27 < 0.6 >( 1 )[ 1 : 0 : 0.594 ]( 27 , 38 , 39 ),<>Tot Used: 159 , Added: 38 , Zero Std: 0 , Max Cor: 0.9365909 
#> 3 , Top: 18 < 0.6 >( 4 )[ 1 : 0 : 0 ]( 15 , 20 , 63 ),<>Tot Used: 160 , Added: 20 , Zero Std: 0 , Max Cor: 0.9408258 
#> 4 , Top: 10 < 0.6 >( 1 )[ 1 : 0 : 0 ]( 10 , 11 , 74 ),<>Tot Used: 161 , Added: 11 , Zero Std: 0 , Max Cor: 0.6387514 
#> 5 , Top: 2 < 0.6 >( 1 )[ 1 : 0 : 0.6 ]( 2 , 2 , 81 ),<>Tot Used: 161 , Added: 2 , Zero Std: 0 , Max Cor: 0.7764574 
#> 6 , Top: 1 < 0.6 >( 1 )[ 1 : 0 : 0.6 ]( 1 , 1 , 81 ),<>Tot Used: 161 , Added: 1 , Zero Std: 0 , Max Cor: 0.5988357 
#> [ 7 ], 0.593303 . Cor to Base: 101 , ABase: 69
TADPOLECrossMRITestD <-  predictDecorrelate(TADPOLECrossMRITrainD,TADPOLECrossMRITest)

2.2 Decorrelated

bmlD <- BSWiMS.model(ADAS13~.,TADPOLECrossMRITrainD,maxTrainModelSize=50,NumberofRepeats = 20)

[++-++-++-++-++-++-++-++-++-++-++-++-++-++-++-++-++-++-++-++-]….

pander::pander(bmlD$bagging$Jaccard.SM)

0.281

fs <- bmlD$bagging$frequencyTable
barplot(fs[order(-fs)],las=2,main="Selected Features",cex.names = 0.5)

sm <- summary(bmlD)
pander::pander(sm$coefficients)

	Estimate	lower	mean	upper	u.MSE	r.MSE	model.MSE	NeRI	F.pvalue	t.pvalue	Sign.pvalue	Wilcox.pvalue	Frequency
Ba_Hippocampus	-166.695	-190.219	-166.695	-143.171	58.6	58.7	42.4	0.22959	0.00e+00	8.02e-26	5.28e-10	1.16e-13	1.00
Ba_M_ST59TA	-1431.291	-1633.277	-1431.291	-1229.305	73.2	54.6	43.2	0.21081	0.00e+00	2.88e-20	1.03e-08	1.45e-11	1.00
De_M_ST58TA	1737.239	1462.807	1737.239	2011.671	81.0	49.3	43.2	0.13784	0.00e+00	1.39e-10	8.52e-05	2.79e-06	1.00
De_M_ST58CV	-406.753	-505.911	-406.753	-307.596	83.7	46.2	43.2	0.12046	0.00e+00	2.46e-06	4.97e-04	1.23e-04	0.95
De_M_ST24TA	-209.054	-274.005	-209.054	-144.103	78.8	44.9	42.4	0.09587	1.41e-10	6.21e-06	5.57e-03	1.17e-03	1.00
RD_ST32TA	13.129	8.928	13.129	17.331	75.0	44.8	42.4	0.00697	4.54e-10	1.52e-02	4.76e-01	1.76e-01	1.00
De_M_ST24CV	-137.823	-189.385	-137.823	-86.261	80.3	45.0	43.2	0.05877	8.08e-08	3.76e-05	5.73e-02	3.84e-03	0.95
Ba_M_ST40TS	838.846	504.556	838.846	1173.136	83.4	44.8	43.3	0.06143	4.37e-07	3.58e-03	4.68e-02	3.46e-02	0.55
RD_ST31TA	12.986	7.763	12.986	18.210	78.1	43.9	42.4	0.04950	5.50e-07	4.43e-03	8.66e-02	4.73e-02	1.00
De_M_ST31TA	-651.605	-924.380	-651.605	-378.830	80.2	44.0	42.6	0.02276	1.42e-06	5.42e-02	2.61e-01	2.37e-01	1.00
De_M_ST60SA	60.052	33.625	60.052	86.479	83.0	44.4	43.1	0.01759	4.22e-06	2.18e-02	2.90e-01	1.30e-01	0.95
De_WholeBrain	11.449	6.349	11.449	16.548	83.8	44.2	43.0	0.07425	5.41e-06	1.97e-04	2.11e-02	4.71e-03	0.25
De_M_ST52TA	-634.123	-927.284	-634.123	-340.961	82.3	44.1	43.0	0.03528	1.12e-05	1.55e-02	1.74e-01	6.11e-02	1.00
M_ST47TS	841.935	452.255	841.935	1231.614	82.0	43.7	42.6	0.05737	1.14e-05	2.80e-03	6.52e-02	2.74e-02	0.90
De_M_ST40SA	-9.693	-14.358	-9.693	-5.028	77.5	43.8	42.7	0.08393	2.32e-05	7.80e-03	1.27e-02	1.57e-02	0.35
Ba_RD_ST40CV	14.111	7.311	14.111	20.911	77.1	44.1	43.1	0.03983	2.38e-05	2.47e-02	1.28e-01	7.34e-02	0.80
De_M_ST40CV	-100.743	-150.158	-100.743	-51.328	80.2	44.0	43.0	0.02646	3.22e-05	5.47e-02	2.55e-01	1.62e-01	0.50
Ba_M_ST129TS	244.673	119.712	244.673	369.633	81.4	43.8	42.9	0.00933	6.21e-05	7.06e-02	4.61e-01	1.83e-01	0.45
M_ST13TS	482.762	231.983	482.762	733.540	79.4	44.2	43.3	0.03335	8.06e-05	9.49e-03	1.79e-01	7.46e-02	0.45
Ba_M_ST32SA	-12.209	-18.693	-12.209	-5.725	77.3	43.9	43.1	0.04780	1.12e-04	5.80e-03	9.47e-02	4.25e-02	0.50
RD_ST40TA	7.117	3.311	7.117	10.923	74.3	44.4	43.6	0.02987	1.24e-04	1.66e-01	2.19e-01	2.51e-01	0.45
De_Ventricles	113.936	51.830	113.936	176.041	77.1	43.3	42.5	0.08919	1.62e-04	1.43e-03	8.47e-03	1.60e-03	1.00
De_M_ST40TA	-96.745	-149.680	-96.745	-43.810	82.7	43.9	43.1	0.04505	1.70e-04	4.71e-02	1.12e-01	6.66e-02	0.15
De_M_ST31SA	-1.145	-1.781	-1.145	-0.510	79.3	43.2	42.4	0.04125	2.07e-04	1.92e-01	1.45e-01	1.72e-01	0.10
De_M_ST32CV	-92.254	-143.546	-92.254	-40.962	81.1	43.9	43.2	0.01630	2.12e-04	1.23e-01	3.20e-01	2.83e-01	0.65
De_M_ST13CV	291.110	126.967	291.110	455.253	82.0	43.5	42.7	0.02646	2.54e-04	8.70e-02	2.07e-01	2.08e-01	0.75
M_ST17SV	33.533	14.551	33.533	52.516	83.8	43.7	42.9	0.05625	2.68e-04	1.71e-03	6.52e-02	1.69e-02	0.55
De_M_ST55SA	-10.147	-15.909	-10.147	-4.385	80.9	43.5	42.7	0.06543	2.79e-04	6.03e-02	3.78e-02	1.22e-01	0.70
Ba_M_ST56SA	-3.335	-5.256	-3.335	-1.414	82.1	43.6	42.9	-0.01778	3.34e-04	1.31e-01	1.00e+00	3.12e-01	0.20
De_M_ST62TA	153.680	63.933	153.680	243.427	83.2	43.1	42.4	0.01262	3.95e-04	1.30e-01	4.08e-01	2.51e-01	0.80
Ba_M_ST65SV	13.099	5.238	13.099	20.961	81.3	43.3	42.6	0.07160	5.46e-04	1.10e-02	2.95e-02	2.54e-02	0.15
Ba_M_ST54TS	141.529	55.372	141.529	227.686	81.6	43.5	42.9	0.01402	6.42e-04	8.27e-02	3.71e-01	2.10e-01	0.35
Ba_M_ST13SA	-21.484	-34.573	-21.484	-8.394	79.5	43.7	43.0	0.03044	6.48e-04	1.15e-01	2.03e-01	1.80e-01	0.75
M_ST24TS	189.693	59.356	189.693	320.030	79.4	43.6	43.1	0.02952	2.17e-03	1.08e-01	2.24e-01	1.95e-01	0.40
RD_ST60TA	0.581	0.180	0.581	0.982	78.2	43.5	43.0	-0.02703	2.28e-03	6.65e-01	1.00e+00	8.66e-01	0.10
Ba_M_ST35SA	-1.890	-3.297	-1.890	-0.483	82.9	43.1	42.6	0.07065	4.24e-03	3.06e-04	3.27e-02	5.85e-03	0.15
RD_ST24TA	3.280	0.824	3.280	5.736	76.3	43.6	43.2	0.03253	4.43e-03	2.53e-01	1.79e-01	2.57e-01	0.75
De_M_ST52CV	44.974	10.243	44.974	79.705	82.7	43.5	43.1	0.00711	5.57e-03	9.54e-02	5.08e-01	2.85e-01	0.15
RD_ST29SV	1.339	0.237	1.339	2.441	78.3	43.5	43.1	0.08393	8.63e-03	3.62e-02	1.43e-02	1.23e-02	0.10

pander::pander(bmlD$univariate[bmlD$selectedfeatures,])

	Name	RName	ZUni
Ba_Hippocampus	Ba_Hippocampus	Ba_Hippocampus	Inf
De_M_ST24TA	De_M_ST24TA	De_M_ST24TA	6.78
RD_ST32TA	RD_ST32TA	RD_ST32TA	Inf
RD_ST56TA	RD_ST56TA	RD_ST56TA	4.31
RD_ST31TA	RD_ST31TA	RD_ST31TA	7.19
De_RD_ST15CV	De_RD_ST15CV	De_RD_ST15CV	3.34
De_M_ST62TA	De_M_ST62TA	De_M_ST62TA	2.79
Ba_M_ST65SV	Ba_M_ST65SV	Ba_M_ST65SV	4.91
De_Ventricles	De_Ventricles	De_Ventricles	7.78
De_M_ST31TA	De_M_ST31TA	De_M_ST31TA	5.78
De_M_ST31SA	De_M_ST31SA	De_M_ST31SA	6.44
M_ST47TS	M_ST47TS	M_ST47TS	4.16
Ba_M_ST59TA	Ba_M_ST59TA	Ba_M_ST59TA	Inf
Ba_M_ST13SA	Ba_M_ST13SA	Ba_M_ST13SA	6.27
De_M_ST13CV	De_M_ST13CV	De_M_ST13CV	4.22
De_M_ST55SA	De_M_ST55SA	De_M_ST55SA	5.22
Ba_M_ST129TS	Ba_M_ST129TS	Ba_M_ST129TS	4.73
De_M_ST58TA	De_M_ST58TA	De_M_ST58TA	5.14
De_M_ST24CV	De_M_ST24CV	De_M_ST24CV	5.72
De_M_ST52TA	De_M_ST52TA	De_M_ST52TA	3.88
De_M_ST32CV	De_M_ST32CV	De_M_ST32CV	5.03
RD_ST24TA	RD_ST24TA	RD_ST24TA	8.21
Ba_RD_ST40CV	Ba_RD_ST40CV	Ba_RD_ST40CV	7.82
RD_ST40TA	RD_ST40TA	RD_ST40TA	Inf
RD_ST29SV	RD_ST29SV	RD_ST29SV	7.10
De_M_ST40CV	De_M_ST40CV	De_M_ST40CV	5.76
De_M_ST40SA	De_M_ST40SA	De_M_ST40SA	7.54
RD_ST60TA	RD_ST60TA	RD_ST60TA	7.13
M_ST13TS	M_ST13TS	M_ST13TS	6.31
Ba_M_ST32SA	Ba_M_ST32SA	Ba_M_ST32SA	7.68
Ba_M_ST40TS	Ba_M_ST40TS	Ba_M_ST40TS	2.36
M_ST24TS	M_ST24TS	M_ST24TS	6.37
Ba_M_ST54TS	Ba_M_ST54TS	Ba_M_ST54TS	4.63
De_M_ST60SA	De_M_ST60SA	De_M_ST60SA	3.03
De_M_ST58CV	De_M_ST58CV	De_M_ST58CV	1.69
Ba_M_ST37SV	Ba_M_ST37SV	Ba_M_ST37SV	Inf
De_WholeBrain	De_WholeBrain	De_WholeBrain	1.53
De_M_ST52CV	De_M_ST52CV	De_M_ST52CV	3.40
M_ST17SV	M_ST17SV	M_ST17SV	1.60
M_ST60TS	M_ST60TS	M_ST60TS	4.22
Ba_M_ST56SA	Ba_M_ST56SA	Ba_M_ST56SA	4.13
Ba_M_ST35SA	Ba_M_ST35SA	Ba_M_ST35SA	3.09
De_M_ST40TA	De_M_ST40TA	De_M_ST40TA	3.43
De_M_ST31CV	De_M_ST31CV	De_M_ST31CV	3.47

prreg <- predictionStats_regression(cbind(TADPOLECrossMRITestD$ADAS13,predict(bmlD,TADPOLECrossMRITestD)),"ADAS13")

ADAS13

pander::pander(prreg)

• corci:

  cor
  0.704	0.665	0.74

• biasci: -0.396, -0.910 and 0.118

• RMSEci: 6.96, 6.62 and 7.35

• spearmanci:

  50%	2.5%	97.5%
  0.673	0.625	0.714

• MAEci:

  50%	2.5%	97.5%
  5.37	5.05	5.7

• pearson:

  Pearson’s product-moment correlation: predictions[, 1] and predictions[, 2]

  Test statistic	df	P value	Alternative hypothesis	cor
  26.3	702	1.32e-106 * * *	two.sided	0.704

par(op)

2.2.1 The formula network

cmax <- apply(bmlD$bagging$formulaNetwork,2,max)
cnames <- names(cmax[cmax>=0.250])
cmax <- cmax[cnames]

adma <- bmlD$bagging$formulaNetwork[cnames,cnames]

adma[adma<0.15] <- 0;
gr <- graph_from_adjacency_matrix(adma,mode = "undirected",diag = FALSE,weighted=TRUE)
gr$layout <- layout_with_fr

fc <- cluster_optimal(gr)
plot(fc, gr,
     edge.width=5*E(gr)$weight,
     vertex.size=20*cmax,
     vertex.label.cex=0.5,
     vertex.label.dist=0,
     main="ADAS13 Feature Association")

par(op)

2.2.2 Decorrelated ADAS13 table

clusterFeatures <- fc$names
sm$coefficients$Rx2 <- (sm$coefficients$r.MSE-sm$coefficients$model.MSE)/sm$coefficients$r.MSE

tableADAS13D <- sm$coefficients[clusterFeatures,
                                   c("Estimate",
                                     "lower",
                                     "mean",
                                     "upper",
                                     "model.MSE",
                                     "Rx2",
                                     "F.pvalue",
                                     "Frequency")]

nugget <- fc$membership
names(nugget) <- clusterFeatures

tableADAS13D$Cluster <- nugget[rownames(tableADAS13D)]

rnames <- clusterFeatures[str_detect(clusterFeatures,"ST")]
frnames <- rnames
rnames <- str_replace_all(rnames,"M_","")
rnames <- str_replace_all(rnames,"RD_","")
rnames <- str_replace_all(rnames,"Ba_","")
rnames <- str_replace_all(rnames,"De_","")
description <- character()

for (ddet in c(1:length(rnames)))
{
  description <- c(description,TADPOLE_D1_D2_Dict$TEXT[str_detect(TADPOLE_D1_D2_Dict$FLDNAME,rnames[ddet])][1])
}
names(description) <- frnames

tableADAS13D$Description <- description[rownames(tableADAS13D)]

## Getting the decorrelation formula
dc <- getDerivedCoefficients(TADPOLECrossMRITrainD)
decornames <- rownames(sm$coefficients)

deNames_in_dc <- decornames[decornames %in% names(dc)]
theDeFormulas <- dc[deNames_in_dc]
deFromula <- character(length(theDeFormulas))
names(deFromula) <- names(theDeFormulas)
for (dx in names(deFromula))
{
  coef <- theDeFormulas[[dx]]
  cname <- names(theDeFormulas[[dx]])
  names(cname) <- cname
  for (cf in names(coef))
  {
    if (cf != dx)
    {
      if (coef[cf]>0)
      {
        deFromula[dx] <- paste(deFromula[dx],
                               sprintf("+ %5.3f*%s",coef[cf],cname[cf]))
      }
      else
      {
        deFromula[dx] <- paste(deFromula[dx],
                               sprintf("%5.3f*%s",coef[cf],cname[cf]))
      }
    }
  }
}

tableADAS13D$DecorFormula <- deFromula[rownames(tableADAS13D)]


pander::pander(tableADAS13D)

	Estimate	lower	mean	upper	model.MSE	Rx2	F.pvalue	Frequency	Cluster	Description	DecorFormula
Ba_Hippocampus	-166.70	-190.219	-166.70	-143.17	42.4	0.27748	0.00e+00	1.00	1	NA	NA
De_M_ST24TA	-209.05	-274.005	-209.05	-144.10	42.4	0.05509	1.41e-10	1.00	1	Cortical Thickness Average of LeftEntorhinal	-0.314Hippocampus + 1.000M_ST24TA
RD_ST32TA	13.13	8.928	13.13	17.33	42.4	0.05201	4.54e-10	1.00	1	Cortical Thickness Average of LeftInferiorTemporal	NA
RD_ST31TA	12.99	7.763	12.99	18.21	42.4	0.03324	5.50e-07	1.00	1	Cortical Thickness Average of LeftInferiorParietal	NA
De_M_ST62TA	153.68	63.933	153.68	243.43	42.4	0.01594	3.95e-04	0.80	1	Cortical Thickness Average of LeftTransverseTemporal	-0.922M_ST59TA + 1.000M_ST62TA
De_Ventricles	113.94	51.830	113.94	176.04	42.5	0.01832	1.62e-04	1.00	1	NA	+ 1.000Ventricles -1.284M_ST37SV
De_M_ST31TA	-651.61	-924.380	-651.61	-378.83	42.6	0.03074	1.42e-06	1.00	1	Cortical Thickness Average of LeftInferiorParietal	+ 1.000M_ST31TA -0.934M_ST59TA
M_ST47TS	841.93	452.255	841.93	1231.61	42.6	0.02529	1.14e-05	0.90	1	Cortical Thickness Standard Deviation of LeftParsTriangularis	NA
Ba_M_ST59TA	-1431.29	-1633.277	-1431.29	-1229.30	43.2	0.20785	0.00e+00	1.00	2	Cortical Thickness Average of LeftSupramarginal	NA
Ba_M_ST13SA	-21.48	-34.573	-21.48	-8.39	43.0	0.01469	6.48e-04	0.75	2	Surface Area of LeftBankssts	NA
De_M_ST13CV	291.11	126.967	291.11	455.25	42.7	0.01710	2.54e-04	0.75	1	Volume (Cortical Parcellation) of LeftBankssts	-1.727M_ST13TA -0.213M_ST59TA -0.295M_ST13SA + 1.000M_ST13CV
De_M_ST55SA	-10.15	-15.909	-10.15	-4.38	42.7	0.01690	2.79e-04	0.70	1	Surface Area of LeftRostralMiddleFrontal	NA
Ba_M_ST129TS	244.67	119.712	244.67	369.63	42.9	0.02077	6.21e-05	0.45	1	Cortical Thickness Standard Deviation of LeftInsula	NA
De_M_ST58TA	1737.24	1462.807	1737.24	2011.67	43.2	0.12280	0.00e+00	1.00	2	Cortical Thickness Average of LeftSuperiorTemporal	-0.130Hippocampus + 1.000M_ST58TA -0.561*M_ST59TA
De_M_ST24CV	-137.82	-189.385	-137.82	-86.26	43.2	0.03838	8.08e-08	0.95	2	Volume (Cortical Parcellation) of LeftEntorhinal	-0.552Hippocampus + 1.000M_ST24CV
De_M_ST52TA	-634.12	-927.284	-634.12	-340.96	43.0	0.02527	1.12e-05	1.00	2	Cortical Thickness Average of LeftPrecuneus	+ 1.000M_ST52TA -0.850M_ST59TA
De_M_ST32CV	-92.25	-143.546	-92.25	-40.96	43.2	0.01808	2.12e-04	0.65	2	Volume (Cortical Parcellation) of LeftInferiorTemporal	-2.388M_ST59TA -0.270M_ST32SA + 1.000*M_ST32CV
RD_ST24TA	3.28	0.824	3.28	5.74	43.2	0.00979	4.43e-03	0.75	2	Cortical Thickness Average of LeftEntorhinal	NA
Ba_RD_ST40CV	14.11	7.311	14.11	20.91	43.1	0.02330	2.38e-05	0.80	2	Volume (Cortical Parcellation) of LeftMiddleTemporal	NA
RD_ST40TA	7.12	3.311	7.12	10.92	43.6	0.01901	1.24e-04	0.45	2	Cortical Thickness Average of LeftMiddleTemporal	NA
De_M_ST40CV	-100.74	-150.158	-100.74	-51.33	43.0	0.02259	3.22e-05	0.50	2	Volume (Cortical Parcellation) of LeftMiddleTemporal	-2.845M_ST59TA -0.273M_ST40SA + 1.000*M_ST40CV
De_M_ST40SA	-9.69	-14.358	-9.69	-5.03	42.7	0.02345	2.32e-05	0.35	2	Surface Area of LeftMiddleTemporal	NA
M_ST13TS	482.76	231.983	482.76	733.54	43.3	0.02011	8.06e-05	0.45	2	Cortical Thickness Standard Deviation of LeftBankssts	NA
Ba_M_ST32SA	-12.21	-18.693	-12.21	-5.72	43.1	0.01920	1.12e-04	0.50	2	Surface Area of LeftInferiorTemporal	NA
Ba_M_ST40TS	838.85	504.556	838.85	1173.14	43.3	0.03400	4.37e-07	0.55	2	Cortical Thickness Standard Deviation of LeftMiddleTemporal	NA
M_ST24TS	189.69	59.356	189.69	320.03	43.1	0.01154	2.17e-03	0.40	2	Cortical Thickness Standard Deviation of LeftEntorhinal	NA
Ba_M_ST54TS	141.53	55.372	141.53	227.69	42.9	0.01477	6.42e-04	0.35	2	Cortical Thickness Standard Deviation of LeftRostralAnteriorCingulate	NA
De_M_ST60SA	60.05	33.625	60.05	86.48	43.1	0.02798	4.22e-06	0.95	2	Surface Area of LeftTemporalPole	NA
De_M_ST58CV	-406.75	-505.911	-406.75	-307.60	43.2	0.06429	0.00e+00	0.95	2	Volume (Cortical Parcellation) of LeftSuperiorTemporal	-3.359M_ST59TA -0.243M_ST58SA + 1.000*M_ST58CV
De_WholeBrain	11.45	6.349	11.45	16.55	43.0	0.02731	5.41e-06	0.25	2	NA	-1.479Hippocampus + 1.000WholeBrain
M_ST17SV	33.53	14.551	33.53	52.52	42.9	0.01696	2.68e-04	0.55	2	Volume (WM Parcellation) of LeftCerebellumCortex	NA

3 Diagnosis MCI vs AD

3.0.1 the set

TrainFraction <- 0.60;

TADPOLECrossMRI <- subset(validBaselineTadpole,DX == "Dementia" | DX == "MCI")
table(TADPOLECrossMRI$DX)

Dementia MCI NL 244 711 0

TADPOLECrossMRI$DX <- 1*(as.character(TADPOLECrossMRI$DX) == "Dementia")
table(TADPOLECrossMRI$DX)

0 1 711 244

TADPOLECrossMRI$ADAS13 <- NULL
TADPOLECrossMRI$ADAS11 <- NULL
TADPOLECrossMRI$MMSE <- NULL
TADPOLECrossMRI$RAVLT_immediate <- NULL
TADPOLECrossMRI$RAVLT_learning <- NULL
TADPOLECrossMRI$RAVLT_perc_forgetting <- NULL
TADPOLECrossMRI$RAVLT_forgetting <- NULL
TADPOLECrossMRI$FAQ <- NULL

TADPOLE_Cases <- subset(TADPOLECrossMRI,DX==1)
TADPOLE_Controls <- subset(TADPOLECrossMRI,DX==0)
trainCasesSet <- sample(nrow(TADPOLE_Cases),nrow(TADPOLE_Cases)*TrainFraction)
trainControlSet <- sample(nrow(TADPOLE_Controls),nrow(TADPOLE_Controls)*TrainFraction)

TADPOLE_DX_TRAIN <- rbind(TADPOLE_Cases[trainCasesSet,],TADPOLE_Controls[trainControlSet,])
TADPOLE_DX_TEST <- TADPOLECrossMRI[!(rownames(TADPOLECrossMRI) %in% rownames(TADPOLE_DX_TRAIN)),]
table(TADPOLE_DX_TEST$DX)

0 1 285 98

par(op)

3.0.2 Learning

bDXml <- BSWiMS.model(DX~.,TADPOLE_DX_TRAIN,NumberofRepeats = 20)

[++++-+-+++++-+++++-+++++++-+++++-+-++++–++++++-+++—-+++++–++++–+-++++++-++++++-+++-++-+++++-+++-++-++++++-++++++-++++-+-+++++–++-+–]……….

pander::pander(bDXml$bagging$Jaccard.SM)

0.0986

fs <- bDXml$bagging$frequencyTable
barplot(fs[order(-fs)],las=2,main="Selected Features",cex.names = 0.5)

sm <- summary(bDXml)
pander::pander(sm$coefficients)

	Estimate	lower	OR	upper	u.Accuracy	r.Accuracy	full.Accuracy	u.AUC	r.AUC	full.AUC	IDI	NRI	z.IDI	z.NRI	Frequency
M_ST24TA	-48.263	1.01e-24	1.10e-21	1.19e-18	0.727	0.691	0.748	0.724	0.690	0.757	0.1146	0.676	10.63	10.55	1.00
M_ST24CV	-27.345	1.26e-14	1.33e-12	1.41e-10	0.694	0.695	0.741	0.691	0.694	0.745	0.0888	0.553	9.01	8.54	1.00
Hippocampus	-14.025	6.53e-08	8.11e-07	1.01e-05	0.683	0.684	0.719	0.687	0.683	0.726	0.0886	0.538	8.96	8.29	0.90
M_ST58TA	-7.204	2.05e-04	7.43e-04	2.69e-03	0.646	0.667	0.711	0.646	0.667	0.716	0.0771	0.522	8.44	7.92	0.10
M_ST12SV	-20.770	1.36e-11	9.54e-10	6.69e-08	0.684	0.694	0.723	0.692	0.694	0.731	0.0639	0.540	7.66	8.22	0.90
M_ST60TA	-23.861	2.25e-13	4.34e-11	8.36e-09	0.659	0.683	0.716	0.661	0.685	0.718	0.0627	0.465	7.50	7.04	0.70
M_ST32TA	-68.352	6.65e-37	2.07e-30	6.42e-24	0.663	0.702	0.721	0.668	0.705	0.728	0.0656	0.532	7.46	8.13	0.95
M_ST26TA	-9.939	7.13e-06	4.83e-05	3.27e-04	0.647	0.707	0.728	0.650	0.707	0.727	0.0697	0.460	7.40	7.07	0.10
M_ST40TA	-28.750	6.76e-16	3.27e-13	1.58e-10	0.671	0.687	0.725	0.673	0.687	0.727	0.0618	0.498	7.36	7.59	0.45
M_ST40CV	-7.280	1.28e-04	6.90e-04	3.71e-03	0.668	0.693	0.716	0.668	0.686	0.719	0.0550	0.458	7.09	6.91	0.60
M_ST32CV	-17.997	1.96e-10	1.53e-08	1.19e-06	0.684	0.727	0.751	0.682	0.726	0.757	0.0544	0.514	6.92	7.80	1.00
M_ST32SA	-2.607	3.75e-02	7.37e-02	1.45e-01	0.627	0.693	0.724	0.619	0.691	0.725	0.0463	0.487	6.52	7.36	0.60
M_ST31CV	-10.484	1.52e-06	2.80e-05	5.16e-04	0.648	0.716	0.731	0.648	0.716	0.740	0.0450	0.369	6.36	5.52	0.75
M_ST30SV	4.199	1.71e+01	6.66e+01	2.59e+02	0.674	0.718	0.733	0.671	0.718	0.738	0.0352	0.308	5.63	4.58	1.00
M_ST60TS	48.891	5.52e+13	1.71e+21	5.31e+28	0.615	0.700	0.717	0.610	0.709	0.724	0.0312	0.416	5.47	6.23	0.60
M_ST60SA	1.250	2.23e+00	3.49e+00	5.46e+00	0.519	0.733	0.760	0.516	0.735	0.770	0.0308	0.339	5.37	5.05	0.10
M_ST13TS	107.209	4.04e+29	3.63e+46	3.27e+63	0.594	0.714	0.719	0.578	0.715	0.723	0.0351	0.333	5.31	4.96	0.65
M_ST40TS	18.046	7.27e+04	6.88e+07	6.50e+10	0.577	0.707	0.721	0.550	0.705	0.722	0.0314	0.355	5.10	5.30	0.20
M_ST46TS	151.043	2.49e+41	3.95e+65	6.29e+89	0.569	0.736	0.748	0.550	0.744	0.756	0.0306	0.330	5.07	4.92	1.00
RD_ST52TA	1.761	2.96e+00	5.82e+00	1.14e+01	0.608	0.722	0.732	0.553	0.727	0.735	0.0294	0.211	5.05	3.18	0.85
RD_ST32TA	0.965	1.81e+00	2.62e+00	3.79e+00	0.645	0.707	0.728	0.610	0.715	0.732	0.0295	0.425	5.00	6.42	0.70
RD_ST35TA	1.302	2.23e+00	3.68e+00	6.06e+00	0.625	0.701	0.720	0.600	0.706	0.723	0.0278	0.383	4.99	5.75	0.75
M_ST129TS	40.276	3.94e+10	3.10e+17	2.45e+24	0.585	0.721	0.728	0.564	0.723	0.728	0.0290	0.287	4.87	4.27	0.40
M_ST24SA	6.624	6.07e+01	7.53e+02	9.35e+03	0.538	0.726	0.740	0.549	0.735	0.743	0.0270	0.202	4.85	2.98	0.75
M_ST35SA	-0.478	5.10e-01	6.20e-01	7.54e-01	0.554	0.701	0.723	0.563	0.703	0.730	0.0238	0.314	4.76	4.65	0.20
M_ST39CV	5.651	2.87e+01	2.85e+02	2.82e+03	0.565	0.718	0.730	0.555	0.723	0.735	0.0250	0.226	4.73	3.33	0.45
M_ST43TS	151.462	2.65e+38	6.01e+65	1.37e+93	0.548	0.727	0.734	0.530	0.732	0.739	0.0259	0.274	4.55	4.06	1.00
M_ST47CV	3.612	7.90e+00	3.70e+01	1.74e+02	0.551	0.712	0.726	0.545	0.720	0.733	0.0220	0.258	4.49	3.81	0.30
M_ST21SV	2.141	3.38e+00	8.51e+00	2.14e+01	0.615	0.718	0.721	0.614	0.720	0.727	0.0241	0.249	4.47	3.67	0.20
M_ST26CV	-1.809	7.47e-02	1.64e-01	3.59e-01	0.659	0.711	0.721	0.655	0.711	0.723	0.0232	0.332	4.34	4.94	0.25
RD_ST55TA	0.358	1.22e+00	1.43e+00	1.67e+00	0.623	0.712	0.724	0.590	0.717	0.724	0.0220	0.318	4.30	4.75	0.15
RD_ST66SV	-0.424	5.33e-01	6.55e-01	8.04e-01	0.524	0.724	0.731	0.578	0.728	0.735	0.0184	0.332	3.92	5.06	0.55
M_ST43TA	8.373	6.47e+01	4.33e+03	2.90e+05	0.562	0.724	0.728	0.545	0.728	0.731	0.0163	0.274	3.78	4.06	0.15

pander::pander(bDXml$univariate[bDXml$selectedfeatures,])

	Name	RName	ZUni
M_ST24TA	M_ST24TA	M_ST24TA	10.60
M_ST32CV	M_ST32CV	M_ST32CV	8.92
M_ST24CV	M_ST24CV	M_ST24CV	9.26
M_ST46TS	M_ST46TS	M_ST46TS	2.35
M_ST31CV	M_ST31CV	M_ST31CV	7.46
M_ST30SV	M_ST30SV	M_ST30SV	8.76
M_ST60SA	M_ST60SA	M_ST60SA	1.69
M_ST24SA	M_ST24SA	M_ST24SA	1.92
Hippocampus	Hippocampus	Hippocampus	9.46
RD_ST52TA	RD_ST52TA	RD_ST52TA	4.44
M_ST43TS	M_ST43TS	M_ST43TS	2.56
M_ST12SV	M_ST12SV	M_ST12SV	8.92
RD_ST32TA	RD_ST32TA	RD_ST32TA	4.42
M_ST51TA	M_ST51TA	M_ST51TA	3.67
M_ST129TS	M_ST129TS	M_ST129TS	3.38
M_ST47CV	M_ST47CV	M_ST47CV	1.88
M_ST32TA	M_ST32TA	M_ST32TA	8.12
M_ST60TS	M_ST60TS	M_ST60TS	4.09
M_ST56TS	M_ST56TS	M_ST56TS	2.72
M_ST43TA	M_ST43TA	M_ST43TA	2.80
M_ST39CV	M_ST39CV	M_ST39CV	2.94
M_ST13TS	M_ST13TS	M_ST13TS	4.64
M_ST60TA	M_ST60TA	M_ST60TA	7.09
RD_ST35TA	RD_ST35TA	RD_ST35TA	3.69
M_ST40CV	M_ST40CV	M_ST40CV	7.68
RD_ST66SV	RD_ST66SV	RD_ST66SV	3.11
M_ST45TS	M_ST45TS	M_ST45TS	4.17
M_ST32SA	M_ST32SA	M_ST32SA	5.60
M_ST26TA	M_ST26TA	M_ST26TA	7.42
RD_ST55TA	RD_ST55TA	RD_ST55TA	3.54
ST5SV	ST5SV	ST5SV	4.92
M_ST26CV	M_ST26CV	M_ST26CV	7.48
M_ST58TA	M_ST58TA	M_ST58TA	7.35
M_ST40TA	M_ST40TA	M_ST40TA	7.16
M_ST40TS	M_ST40TS	M_ST40TS	2.02
M_ST21SV	M_ST21SV	M_ST21SV	6.20
M_ST35SA	M_ST35SA	M_ST35SA	2.73
M_ST15TA	M_ST15TA	M_ST15TA	6.07
M_ST54CV	M_ST54CV	M_ST54CV	1.75

prBin <- predictionStats_binary(cbind(TADPOLE_DX_TEST$DX,predict(bDXml,TADPOLE_DX_TEST)),"MCI vs Dementia")

MCI vs Dementia

pander::pander(prBin$aucs)

est	lower	upper
0.792	0.742	0.841

pander::pander(prBin$accc)

est	lower	upper
0.713	0.665	0.758

pander::pander(prBin$berror)

50%	2.5%	97.5%
0.31	0.261	0.367

pander::pander(prBin$sensitivity)

est	lower	upper
0.643	0.54	0.737

par(op)

3.0.3 The formula network

cmax <- apply(bDXml$bagging$formulaNetwork,2,max)
cnames <- names(cmax[cmax>=0.25])
cmax <- cmax[cnames]

adma <- bDXml$bagging$formulaNetwork[cnames,cnames]

adma[adma<0.15] <- 0;
gr <- graph_from_adjacency_matrix(adma,mode = "undirected",diag = FALSE,weighted=TRUE)
gr$layout <- layout_with_fr

fc <- cluster_optimal(gr)
plot(fc, gr,
     edge.width=10*E(gr)$weight,
     vertex.size=10*cmax,
     vertex.label.cex=0.75,
     vertex.label.dist=0,
     main="MCI vs Dementia Diagnosis")

par(op)

3.0.4 MCI vs AD table

clusterFeatures <- fc$names
sm$coefficients$DeltaAUC <- (sm$coefficients$full.AUC-sm$coefficients$r.AUC)

tableMCI_De <- sm$coefficients[clusterFeatures,
                                   c("Estimate",
                                     "lower",
                                     "OR",
                                     "upper",
                                     "full.AUC",
                                     "DeltaAUC",
                                     "z.IDI",
                                     "Frequency")]

nugget <- fc$membership
names(nugget) <- clusterFeatures

tableMCI_De$Cluster <- nugget[rownames(tableMCI_De)]

rnames <- clusterFeatures[str_detect(clusterFeatures,"ST")]
frnames <- rnames
rnames <- str_replace_all(rnames,"M_","")
rnames <- str_replace_all(rnames,"RD_","")
description <- character()

for (ddet in c(1:length(rnames)))
{
  description <- c(description,TADPOLE_D1_D2_Dict$TEXT[str_detect(TADPOLE_D1_D2_Dict$FLDNAME,rnames[ddet])][1])
}
names(description) <- frnames

tableMCI_De$Description <- description[rownames(tableMCI_De)]
pander::pander(tableMCI_De)

	Estimate	lower	OR	upper	full.AUC	DeltaAUC	z.IDI	Frequency	Cluster	Description
M_ST24TA	-48.263	1.01e-24	1.10e-21	1.19e-18	0.757	0.06716	10.63	1.00	1	Cortical Thickness Average of LeftEntorhinal
M_ST32CV	-17.997	1.96e-10	1.53e-08	1.19e-06	0.757	0.03094	6.92	1.00	1	Volume (Cortical Parcellation) of LeftInferiorTemporal
M_ST24CV	-27.345	1.26e-14	1.33e-12	1.41e-10	0.745	0.05146	9.01	1.00	2	Volume (Cortical Parcellation) of LeftEntorhinal
M_ST46TS	151.043	2.49e+41	3.95e+65	6.29e+89	0.756	0.01183	5.07	1.00	1	Cortical Thickness Standard Deviation of LeftParsOrbitalis
M_ST31CV	-10.484	1.52e-06	2.80e-05	5.16e-04	0.740	0.02480	6.36	0.75	1	Volume (Cortical Parcellation) of LeftInferiorParietal
M_ST30SV	4.199	1.71e+01	6.66e+01	2.59e+02	0.738	0.02072	5.63	1.00	2	Volume (WM Parcellation) of LeftInferiorLateralVentricle
M_ST24SA	6.624	6.07e+01	7.53e+02	9.35e+03	0.743	0.00762	4.85	0.75	2	Surface Area of LeftEntorhinal
Hippocampus	-14.025	6.53e-08	8.11e-07	1.01e-05	0.726	0.04313	8.96	0.90	3	NA
RD_ST52TA	1.761	2.96e+00	5.82e+00	1.14e+01	0.735	0.00859	5.05	0.85	2	Cortical Thickness Average of LeftPrecuneus
M_ST43TS	151.462	2.65e+38	6.01e+65	1.37e+93	0.739	0.00776	4.55	1.00	2	Cortical Thickness Standard Deviation of LeftParacentral
M_ST12SV	-20.770	1.36e-11	9.54e-10	6.69e-08	0.731	0.03630	7.66	0.90	3	Volume (WM Parcellation) of LeftAmygdala
RD_ST32TA	0.965	1.81e+00	2.62e+00	3.79e+00	0.732	0.01723	5.00	0.70	3	Cortical Thickness Average of LeftInferiorTemporal
M_ST129TS	40.276	3.94e+10	3.10e+17	2.45e+24	0.728	0.00473	4.87	0.40	4	Cortical Thickness Standard Deviation of LeftInsula
M_ST47CV	3.612	7.90e+00	3.70e+01	1.74e+02	0.733	0.01282	4.49	0.30	1	Volume (Cortical Parcellation) of LeftParsTriangularis
M_ST32TA	-68.352	6.65e-37	2.07e-30	6.42e-24	0.728	0.02254	7.46	0.95	3	Cortical Thickness Average of LeftInferiorTemporal
M_ST60TS	48.891	5.52e+13	1.71e+21	5.31e+28	0.724	0.01475	5.47	0.60	3	Cortical Thickness Standard Deviation of LeftTemporalPole
M_ST39CV	5.651	2.87e+01	2.85e+02	2.82e+03	0.735	0.01239	4.73	0.45	5	Volume (Cortical Parcellation) of LeftMedialOrbitofrontal
M_ST13TS	107.209	4.04e+29	3.63e+46	3.27e+63	0.723	0.00859	5.31	0.65	3	Cortical Thickness Standard Deviation of LeftBankssts
M_ST60TA	-23.861	2.25e-13	4.34e-11	8.36e-09	0.718	0.03383	7.50	0.70	4	Cortical Thickness Average of LeftTemporalPole
RD_ST35TA	1.302	2.23e+00	3.68e+00	6.06e+00	0.723	0.01661	4.99	0.75	4	Cortical Thickness Average of LeftLateralOccipital
M_ST40CV	-7.280	1.28e-04	6.90e-04	3.71e-03	0.719	0.03314	7.09	0.60	4	Volume (Cortical Parcellation) of LeftMiddleTemporal
RD_ST66SV	-0.424	5.33e-01	6.55e-01	8.04e-01	0.735	0.00623	3.92	0.55	5	Volume (WM Parcellation) of LeftVessel
M_ST32SA	-2.607	3.75e-02	7.37e-02	1.45e-01	0.725	0.03450	6.52	0.60	5	Surface Area of LeftInferiorTemporal
M_ST26CV	-1.809	7.47e-02	1.64e-01	3.59e-01	0.723	0.01140	4.34	0.25	5	Volume (Cortical Parcellation) of LeftFusiform
M_ST40TA	-28.750	6.76e-16	3.27e-13	1.58e-10	0.727	0.03978	7.36	0.45	5	Cortical Thickness Average of LeftMiddleTemporal

3.1 Decorrelating the sets

TADPOLE_DX_TRAIND <- GDSTMDecorrelation(TADPOLE_DX_TRAIN,Outcome="DX",
                                        thr=0.6,
                                        type="RLM",
                                        method="spearman",
                                        verbose = TRUE)
#> 
#>  Included: 196 , Uni p: 0.01242039 To Outcome: 97 , Base: 4 , In Included: 4 , Base Cor: 14 
#> 1 , Top: 38 < 0.6 >( 4 )[ 1 : 0 : 0.594 ]( 37 , 94 , 0 ),<>Tot Used: 131 , Added: 94 , Zero Std: 0 , Max Cor: 0.9891429 
#> 2 , Top: 29 < 0.6 >[ FALSE ]( 1 )[ 1 : 0 : 0.594 ]( 27 , 35 , 37 ),<>Tot Used: 152 , Added: 35 , Zero Std: 0 , Max Cor: 0.9245065 
#> 3 , Top: 17 < 0.6 >( 2 )[ 1 : 0 : 0.594 ]( 17 , 18 , 60 ),<>Tot Used: 154 , Added: 18 , Zero Std: 0 , Max Cor: 0.8463234 
#> 4 , Top: 7 < 0.6 >[ TRUE ]( 1 )[ 1 : 0 : 0 ]( 7 , 8 , 74 ),<>Tot Used: 155 , Added: 8 , Zero Std: 0 , Max Cor: 0.8906106 
#> 5 , Top: 3 < 0.6 >( 1 )[ 1 : 0 : 0 ]( 3 , 3 , 77 ),<>Tot Used: 155 , Added: 3 , Zero Std: 0 , Max Cor: 0.6520013 
#> 6 , Top: 1 < 0.6 >[ FALSE ]( 1 )[ 1 : 0 : 0.6 ]( 1 , 1 , 79 ),<>Tot Used: 155 , Added: 1 , Zero Std: 0 , Max Cor: 0.5983268 
#> [ 7 ], 0.5980715 . Cor to Base: 100 , ABase: 67
TADPOLE_DX_TESTD <-  predictDecorrelate(TADPOLE_DX_TRAIND,TADPOLE_DX_TEST)

3.1.1 Decorrelated ML

bDXmlD <- BSWiMS.model(DX~.,TADPOLE_DX_TRAIND,NumberofRepeats = 20)

[+++-+++-+++—+++-+++-+++-+++-+++-+++-+++-+++-++—+++-+++-+++-+++-+++-+++-+++–+++-]…..

pander::pander(bDXmlD$bagging$Jaccard.SM)

0.25

fs <- bDXmlD$bagging$frequencyTable
barplot(fs[order(-fs)],las=2,main="Selected Features",cex.names = 0.5)

sm <- summary(bDXmlD)
pander::pander(sm$coefficients)

	Estimate	lower	OR	upper	u.Accuracy	r.Accuracy	full.Accuracy	u.AUC	r.AUC	full.AUC	IDI	NRI	z.IDI	z.NRI	Frequency
Ba_M_ST24TA	-105.423	5.68e-53	1.64e-46	4.75e-40	0.727	0.620	0.743	0.724	0.598	0.741	0.2337	0.903	16.20	14.81	1.00
De_M_ST11SV	-263.716	3.51e-142	2.95e-115	2.48e-88	0.659	0.707	0.733	0.653	0.692	0.730	0.0542	0.402	7.12	6.05	1.00
Ba_M_ST31TA	-103.989	5.07e-57	6.89e-46	9.35e-35	0.651	0.711	0.735	0.639	0.705	0.733	0.0535	0.447	6.77	6.73	1.00
De_M_ST30SV	15.914	1.13e+05	8.15e+06	5.87e+08	0.637	0.706	0.736	0.622	0.707	0.733	0.0482	0.406	6.55	6.08	1.00
M_ST21SV	23.969	2.60e+07	2.57e+10	2.53e+13	0.615	0.696	0.718	0.613	0.692	0.720	0.0453	0.386	6.42	5.75	0.85
M_ST35CV	-5.666	5.20e-04	3.46e-03	2.31e-02	0.639	0.695	0.722	0.641	0.699	0.724	0.0373	0.449	5.71	6.75	0.35
Ba_M_ST32SA	-4.706	1.77e-03	9.04e-03	4.63e-02	0.626	0.693	0.718	0.618	0.695	0.720	0.0343	0.454	5.56	6.84	0.85
M_ST55CV	-2.676	2.65e-02	6.88e-02	1.79e-01	0.629	0.695	0.720	0.617	0.697	0.719	0.0342	0.388	5.40	5.78	0.15
RD_ST35TA	1.692	2.97e+00	5.43e+00	9.93e+00	0.626	0.706	0.719	0.600	0.711	0.718	0.0321	0.428	5.38	6.43	0.50
De_M_ST57CV	56.470	4.36e+15	3.35e+24	2.57e+33	0.556	0.702	0.716	0.565	0.703	0.717	0.0330	0.411	5.33	6.16	0.70
M_ST60TS	35.030	2.48e+09	1.63e+15	1.08e+21	0.618	0.696	0.719	0.612	0.696	0.719	0.0266	0.332	5.04	4.94	0.25
RD_ST55TA	0.611	1.45e+00	1.84e+00	2.35e+00	0.624	0.747	0.758	0.592	0.740	0.749	0.0282	0.393	4.90	5.93	0.10
RD_ST32TA	2.715	5.33e+00	1.51e+01	4.28e+01	0.644	0.717	0.733	0.610	0.708	0.730	0.0268	0.349	4.86	5.23	1.00
De_M_ST43TA	129.290	6.80e+33	1.41e+56	2.93e+78	0.556	0.741	0.743	0.553	0.744	0.741	0.0293	0.304	4.84	4.50	1.00
M_ST49CV	-3.730	5.19e-03	2.40e-02	1.11e-01	0.586	0.702	0.716	0.603	0.703	0.718	0.0258	0.327	4.66	4.86	0.25
RD_ST52TA	4.860	1.65e+01	1.29e+02	1.01e+03	0.607	0.727	0.741	0.553	0.729	0.740	0.0269	0.215	4.56	3.24	1.00
M_ST46TS	127.575	2.01e+31	2.54e+55	3.21e+79	0.572	0.716	0.742	0.551	0.709	0.740	0.0231	0.328	4.40	4.89	0.75
RD_ST66SV	-0.768	3.28e-01	4.64e-01	6.55e-01	0.523	0.708	0.721	0.578	0.713	0.722	0.0213	0.352	4.25	5.37	0.80
De_M_ST37SV	-51.165	3.33e-34	6.02e-23	1.09e-11	0.569	0.708	0.719	0.516	0.710	0.721	0.0163	0.296	3.77	4.43	0.70

pander::pander(bDXmlD$univariate[bDXmlD$selectedfeatures,])

	Name	RName	ZUni
Ba_M_ST24TA	Ba_M_ST24TA	Ba_M_ST24TA	10.60
De_M_ST43TA	De_M_ST43TA	De_M_ST43TA	3.64
RD_ST55TA	RD_ST55TA	RD_ST55TA	3.54
RD_ST52TA	RD_ST52TA	RD_ST52TA	4.44
De_M_ST30SV	De_M_ST30SV	De_M_ST30SV	6.96
De_M_ST11SV	De_M_ST11SV	De_M_ST11SV	6.91
Ba_M_ST31TA	Ba_M_ST31TA	Ba_M_ST31TA	6.77
RD_ST32TA	RD_ST32TA	RD_ST32TA	4.42
M_ST46TS	M_ST46TS	M_ST46TS	2.35
M_ST21SV	M_ST21SV	M_ST21SV	6.20
RD_ST35TA	RD_ST35TA	RD_ST35TA	3.69
M_ST60TS	M_ST60TS	M_ST60TS	4.09
Ba_M_ST32SA	Ba_M_ST32SA	Ba_M_ST32SA	5.60
M_ST13TS	M_ST13TS	M_ST13TS	4.64
M_ST35SA	M_ST35SA	M_ST35SA	2.73
M_ST35CV	M_ST35CV	M_ST35CV	5.79
RD_ST66SV	RD_ST66SV	RD_ST66SV	3.11
De_M_ST37SV	De_M_ST37SV	De_M_ST37SV	2.07
M_ST55CV	M_ST55CV	M_ST55CV	5.67
De_M_ST57CV	De_M_ST57CV	De_M_ST57CV	2.55
M_ST49CV	M_ST49CV	M_ST49CV	5.18

prBin <- predictionStats_binary(cbind(TADPOLE_DX_TESTD$DX,predict(bDXmlD,TADPOLE_DX_TESTD)),"MCI vs Dementia")

MCI vs Dementia

pander::pander(prBin$aucs)

est	lower	upper
0.796	0.747	0.846

pander::pander(prBin$accc)

est	lower	upper
0.713	0.665	0.758

pander::pander(prBin$berror)

50%	2.5%	97.5%
0.3	0.248	0.352

pander::pander(prBin$sensitivity)

est	lower	upper
0.673	0.571	0.765

par(op)

3.1.2 The formula network

cmax <- apply(bDXmlD$bagging$formulaNetwork,2,max)
cnames <- names(cmax[cmax>=0.25])
cmax <- cmax[cnames]

adma <- bDXmlD$bagging$formulaNetwork[cnames,cnames]

adma[adma<0.15] <- 0;
gr <- graph_from_adjacency_matrix(adma,mode = "undirected",diag = FALSE,weighted=TRUE)
gr$layout <- layout_with_fr

fc <- cluster_optimal(gr)
plot(fc, gr,
     edge.width=10*E(gr)$weight,
     vertex.size=10*cmax,
     vertex.label.cex=0.75,
     vertex.label.dist=0,
     main="MCI vs Dementia Diagnosis")

par(op)

3.1.3 Decorrelated MCI vs AD table

clusterFeatures <- fc$names
sm$coefficients$DeltaAUC <- (sm$coefficients$full.AUC-sm$coefficients$r.AUC)

tableMCI_DeD <- sm$coefficients[clusterFeatures,
                                   c("Estimate",
                                     "lower",
                                     "OR",
                                     "upper",
                                     "full.AUC",
                                     "DeltaAUC",
                                     "z.IDI",
                                     "Frequency")]

nugget <- fc$membership
names(nugget) <- clusterFeatures

tableMCI_DeD$Cluster <- nugget[rownames(tableMCI_DeD)]

rnames <- clusterFeatures[str_detect(clusterFeatures,"ST")]
frnames <- rnames
rnames <- str_replace_all(rnames,"M_","")
rnames <- str_replace_all(rnames,"RD_","")
rnames <- str_replace_all(rnames,"Ba_","")
rnames <- str_replace_all(rnames,"De_","")
description <- character()

for (ddet in c(1:length(rnames)))
{
  description <- c(description,TADPOLE_D1_D2_Dict$TEXT[str_detect(TADPOLE_D1_D2_Dict$FLDNAME,rnames[ddet])][1])
}
names(description) <- frnames

tableMCI_DeD$Description <- description[rownames(tableMCI_DeD)]



## Getting the decorrelation formula
dc <- getDerivedCoefficients(TADPOLE_DX_TRAIND)
decornames <- rownames(sm$coefficients)

deNames_in_dc <- decornames[decornames %in% names(dc)]
theDeFormulas <- dc[deNames_in_dc]
deFromula <- character(length(theDeFormulas))
names(deFromula) <- names(theDeFormulas)
for (dx in names(deFromula))
{
  coef <- theDeFormulas[[dx]]
  cname <- names(theDeFormulas[[dx]])
  names(cname) <- cname
  for (cf in names(coef))
  {
    if (cf != dx)
    {
      if (coef[cf]>0)
      {
        deFromula[dx] <- paste(deFromula[dx],
                               sprintf("+ %5.3f*%s",coef[cf],cname[cf]))
      }
      else
      {
        deFromula[dx] <- paste(deFromula[dx],
                               sprintf("%5.3f*%s",coef[cf],cname[cf]))
      }
    }
  }
}

tableMCI_DeD$DecorFormula <- deFromula[rownames(tableMCI_DeD)]



pander::pander(tableMCI_DeD)

	Estimate	lower	OR	upper	full.AUC	DeltaAUC	z.IDI	Frequency	Cluster	Description	DecorFormula
Ba_M_ST24TA	-105.423	5.68e-53	1.64e-46	4.75e-40	0.741	0.14354	16.20	1.00	1	Cortical Thickness Average of LeftEntorhinal	NA
De_M_ST43TA	129.290	6.80e+33	1.41e+56	2.93e+78	0.741	-0.00276	4.84	1.00	1	Cortical Thickness Average of LeftParacentral	-0.755M_ST31TA + 1.000M_ST43TA
RD_ST52TA	4.860	1.65e+01	1.29e+02	1.01e+03	0.740	0.01033	4.56	1.00	1	Cortical Thickness Average of LeftPrecuneus	NA
De_M_ST30SV	15.914	1.13e+05	8.15e+06	5.87e+08	0.733	0.02628	6.55	1.00	2	Volume (WM Parcellation) of LeftInferiorLateralVentricle	-0.320Ventricles + 1.000M_ST30SV
De_M_ST11SV	-263.716	3.51e-142	2.95e-115	2.48e-88	0.730	0.03792	7.12	1.00	2	Volume (WM Parcellation) of LeftAccumbensArea	+ 0.000ICV + 1.000M_ST11SV
Ba_M_ST31TA	-103.989	5.07e-57	6.89e-46	9.35e-35	0.733	0.02895	6.77	1.00	2	Cortical Thickness Average of LeftInferiorParietal	NA
RD_ST32TA	2.715	5.33e+00	1.51e+01	4.28e+01	0.730	0.02186	4.86	1.00	2	Cortical Thickness Average of LeftInferiorTemporal	NA
M_ST46TS	127.575	2.01e+31	2.54e+55	3.21e+79	0.740	0.03100	4.40	0.75	2	Cortical Thickness Standard Deviation of LeftParsOrbitalis	NA
M_ST21SV	23.969	2.60e+07	2.57e+10	2.53e+13	0.720	0.02734	6.42	0.85	3	Volume (WM Parcellation) of LeftChoroidPlexus	NA
RD_ST35TA	1.692	2.97e+00	5.43e+00	9.93e+00	0.718	0.00748	5.38	0.50	3	Cortical Thickness Average of LeftLateralOccipital	NA
M_ST60TS	35.030	2.48e+09	1.63e+15	1.08e+21	0.719	0.02247	5.04	0.25	3	Cortical Thickness Standard Deviation of LeftTemporalPole	NA
Ba_M_ST32SA	-4.706	1.77e-03	9.04e-03	4.63e-02	0.720	0.02469	5.56	0.85	3	Surface Area of LeftInferiorTemporal	NA
M_ST35CV	-5.666	5.20e-04	3.46e-03	2.31e-02	0.724	0.02533	5.71	0.35	3	Volume (Cortical Parcellation) of LeftLateralOccipital	NA
RD_ST66SV	-0.768	3.28e-01	4.64e-01	6.55e-01	0.722	0.00936	4.25	0.80	3	Volume (WM Parcellation) of LeftVessel	NA
De_M_ST37SV	-51.165	3.33e-34	6.02e-23	1.09e-11	0.721	0.01143	3.77	0.70	3	Volume (WM Parcellation) of LeftLateralVentricle	-0.821Ventricles + 0.142M_ST30SV + 1.000*M_ST37SV
De_M_ST57CV	56.470	4.36e+15	3.35e+24	2.57e+33	0.717	0.01370	5.33	0.70	3	Volume (Cortical Parcellation) of LeftSuperiorParietal	-0.080M_ST31TA -4.580M_ST57TA -0.187M_ST57SA + 1.000M_ST57CV
M_ST49CV	-3.730	5.19e-03	2.40e-02	1.11e-01	0.718	0.01460	4.66	0.25	3	Volume (Cortical Parcellation) of LeftPostcentral	NA

4 Diagnosis NL vs AD

4.0.1 the set

TrainFraction <- 0.60;

table(validBaselineTadpole$DX)

Dementia MCI NL 244 711 452

TADPOLECrossMRI <- subset(validBaselineTadpole,DX == "Dementia" | DX == "NL")
table(TADPOLECrossMRI$DX)

Dementia MCI NL 244 0 452

TADPOLECrossMRI$DX <- 1*(as.character(TADPOLECrossMRI$DX) == "Dementia")
table(TADPOLECrossMRI$DX)

0 1 452 244

TADPOLECrossMRI$ADAS13 <- NULL
TADPOLECrossMRI$ADAS11 <- NULL
TADPOLECrossMRI$MMSE <- NULL
TADPOLECrossMRI$RAVLT_immediate <- NULL
TADPOLECrossMRI$RAVLT_learning <- NULL
TADPOLECrossMRI$RAVLT_perc_forgetting <- NULL
TADPOLECrossMRI$RAVLT_forgetting <- NULL
TADPOLECrossMRI$FAQ <- NULL

TADPOLE_Cases <- subset(TADPOLECrossMRI,DX==1)
TADPOLE_Controls <- subset(TADPOLECrossMRI,DX==0)
trainCasesSet <- sample(nrow(TADPOLE_Cases),nrow(TADPOLE_Cases)*TrainFraction)
trainControlSet <- sample(nrow(TADPOLE_Controls),nrow(TADPOLE_Controls)*TrainFraction)

TADPOLE_DX_NLDE_TRAIN <- rbind(TADPOLE_Cases[trainCasesSet,],TADPOLE_Controls[trainControlSet,])
TADPOLE_DX_NLDE_TEST <- TADPOLECrossMRI[!(rownames(TADPOLECrossMRI) %in% rownames(TADPOLE_DX_NLDE_TRAIN)),]


pander::pander(table(TADPOLE_DX_NLDE_TRAIN$DX))

0	1
271	146

pander::pander(table(TADPOLE_DX_NLDE_TEST$DX))

0	1
181	98

par(op)

4.0.2 Learning

bDXmlNLDE <- BSWiMS.model(DX~.,TADPOLE_DX_NLDE_TRAIN,NumberofRepeats = 20)

[++++–++–+++-+++++-+++-+++-+-+++-+++-+++-++–++–+—++++-+++-++–++-+-+++-+–+++++-++-]…..

pander::pander(bDXmlNLDE$bagging$Jaccard.SM)

0.162

fs <- bDXmlNLDE$bagging$frequencyTable
barplot(fs[order(-fs)],las=2,main="Selected Features",cex.names = 0.5)

sm <- summary(bDXmlNLDE)
pander::pander(sm$coefficients)

	Estimate	lower	OR	upper	u.Accuracy	r.Accuracy	full.Accuracy	u.AUC	r.AUC	full.AUC	IDI	NRI	z.IDI	z.NRI	Frequency
M_ST24CV	-126.5779	6.26e-64	1.07e-55	1.82e-47	0.826	0.826	0.896	0.824	0.825	0.893	0.1686	1.016	10.95	14.22	0.90
M_ST40TA	-285.7177	2.12e-146	8.21e-125	3.18e-103	0.793	0.826	0.878	0.783	0.825	0.878	0.1338	0.963	9.11	13.19	0.55
M_ST31TA	-49.7253	4.68e-28	2.54e-22	1.38e-16	0.724	0.819	0.854	0.715	0.814	0.851	0.0832	0.808	7.37	10.36	0.15
M_ST12SV	-70.9568	5.93e-38	1.53e-31	3.93e-25	0.800	0.860	0.889	0.797	0.858	0.888	0.0721	0.619	6.60	7.92	0.70
M_ST43TA	27.9320	1.52e+09	1.35e+12	1.20e+15	0.582	0.829	0.848	0.566	0.823	0.844	0.0728	0.645	6.60	7.97	0.10
M_ST24TA	-71.8333	1.53e-41	6.36e-32	2.64e-22	0.849	0.893	0.908	0.841	0.891	0.905	0.0596	0.632	6.11	7.84	1.00
Hippocampus	-32.2588	4.61e-19	9.78e-15	2.07e-10	0.835	0.875	0.908	0.828	0.871	0.905	0.0563	0.544	5.96	6.67	1.00
M_ST32TA	-89.7553	7.83e-50	1.05e-39	1.40e-29	0.815	0.842	0.874	0.807	0.841	0.873	0.0675	0.594	5.89	7.52	0.35
M_ST36CV	60.0446	1.63e+17	1.19e+26	8.77e+34	0.608	0.889	0.910	0.603	0.888	0.908	0.0441	0.562	5.51	6.95	1.00
M_ST32CV	-24.0787	1.06e-14	3.49e-11	1.14e-07	0.769	0.861	0.877	0.760	0.857	0.876	0.0512	0.632	5.28	7.94	0.50
M_ST31CV	-26.4590	1.68e-16	3.23e-12	6.21e-08	0.717	0.897	0.910	0.710	0.894	0.908	0.0404	0.460	5.16	5.60	0.70
M_ST51TA	62.0353	1.28e+17	8.74e+26	5.95e+36	0.597	0.865	0.879	0.581	0.863	0.875	0.0502	0.650	5.12	8.25	0.25
M_ST60TA	-12.5257	2.58e-08	3.63e-06	5.12e-04	0.744	0.832	0.854	0.739	0.829	0.851	0.0421	0.535	4.90	6.52	0.15
M_ST24SA	27.9763	2.30e+07	1.41e+12	8.66e+16	0.595	0.886	0.897	0.604	0.883	0.893	0.0367	0.538	4.84	6.67	0.85
M_ST39CV	23.5529	1.54e+06	1.69e+10	1.87e+14	0.580	0.864	0.879	0.577	0.864	0.879	0.0381	0.416	4.84	5.01	0.55
RD_ST32TA	4.5975	1.62e+01	9.92e+01	6.07e+02	0.686	0.888	0.908	0.668	0.885	0.905	0.0403	0.565	4.83	6.99	1.00
RD_ST29SV	5.1023	2.02e+01	1.64e+02	1.34e+03	0.664	0.864	0.878	0.639	0.864	0.879	0.0372	0.744	4.67	9.60	0.35
M_ST30SV	18.1771	3.65e+04	7.84e+07	1.68e+11	0.765	0.876	0.890	0.760	0.874	0.888	0.0365	0.531	4.50	6.52	0.80
M_ST44CV	-12.8990	9.47e-09	2.50e-06	6.60e-04	0.714	0.851	0.862	0.710	0.848	0.859	0.0358	0.490	4.42	5.99	0.25
M_ST40CV	-13.4866	3.87e-09	1.39e-06	4.99e-04	0.756	0.873	0.891	0.753	0.870	0.888	0.0329	0.524	4.38	6.37	0.35
M_ST32SA	-2.7298	1.87e-02	6.52e-02	2.28e-01	0.645	0.867	0.873	0.642	0.862	0.871	0.0318	0.467	4.18	5.63	0.20
M_ST45TA	94.8982	3.42e+22	1.64e+41	7.82e+59	0.649	0.867	0.878	0.637	0.868	0.879	0.0328	0.682	4.17	8.58	0.30
M_ST60TS	81.2727	8.39e+18	1.98e+35	4.67e+51	0.621	0.864	0.875	0.615	0.861	0.873	0.0258	0.465	4.13	5.68	0.40
M_ST13CV	-18.8357	7.01e-13	6.60e-09	6.22e-05	0.737	0.891	0.896	0.733	0.887	0.892	0.0236	0.287	3.94	3.45	0.40
M_ST40TS	209.4990	8.04e+46	9.64e+90	1.16e+135	0.521	0.862	0.876	0.513	0.861	0.877	0.0283	0.562	3.90	6.95	0.40
M_ST31SA	-1.4821	1.06e-01	2.27e-01	4.86e-01	0.617	0.868	0.876	0.615	0.869	0.880	0.0224	0.429	3.76	5.16	0.15
RD_ST39SA	-1.1342	1.81e-01	3.22e-01	5.73e-01	0.532	0.882	0.882	0.557	0.879	0.878	0.0265	0.469	3.75	5.68	0.15
RD_ST40TA	4.0553	7.48e+00	5.77e+01	4.45e+02	0.628	0.871	0.883	0.601	0.867	0.878	0.0271	0.403	3.74	4.87	0.55
ST3SV	-0.3718	5.70e-01	6.90e-01	8.34e-01	0.625	0.878	0.889	0.627	0.877	0.886	0.0275	0.519	3.73	6.34	0.50
M_ST24TS	18.5224	7.33e+03	1.11e+08	1.67e+12	0.603	0.849	0.855	0.600	0.844	0.852	0.0244	0.426	3.63	5.15	0.10
M_ST13SA	-1.0250	2.08e-01	3.59e-01	6.19e-01	0.640	0.892	0.902	0.649	0.889	0.899	0.0180	0.588	3.61	7.26	0.15
ST127SV	-0.0347	9.48e-01	9.66e-01	9.84e-01	0.611	0.875	0.887	0.606	0.874	0.884	0.0214	0.419	3.47	5.07	0.20
M_ST60SA	1.9934	2.42e+00	7.34e+00	2.23e+01	0.542	0.888	0.897	0.543	0.885	0.893	0.0180	0.416	3.47	4.98	0.15
RD_ST129SA	0.6783	1.35e+00	1.97e+00	2.88e+00	0.552	0.852	0.858	0.540	0.850	0.856	0.0192	0.428	3.38	5.18	0.10

pander::pander(bDXmlNLDE$univariate[bDXmlNLDE$selectedfeatures,])

	Name	RName	ZUni
M_ST24TA	M_ST24TA	M_ST24TA	19.86
Hippocampus	Hippocampus	Hippocampus	18.92
RD_ST32TA	RD_ST32TA	RD_ST32TA	7.45
M_ST13SA	M_ST13SA	M_ST13SA	5.68
M_ST24CV	M_ST24CV	M_ST24CV	18.12
M_ST36CV	M_ST36CV	M_ST36CV	5.43
M_ST31CV	M_ST31CV	M_ST31CV	11.31
M_ST24SA	M_ST24SA	M_ST24SA	3.85
M_ST13CV	M_ST13CV	M_ST13CV	11.00
M_ST30SV	M_ST30SV	M_ST30SV	13.44
M_ST12SV	M_ST12SV	M_ST12SV	16.29
RD_ST39SA	RD_ST39SA	RD_ST39SA	2.06
M_ST60SA	M_ST60SA	M_ST60SA	1.58
M_ST40CV	M_ST40CV	M_ST40CV	13.69
M_ST32TA	M_ST32TA	M_ST32TA	14.97
M_ST15TA	M_ST15TA	M_ST15TA	8.87
RD_ST40TA	RD_ST40TA	RD_ST40TA	6.14
M_ST32CV	M_ST32CV	M_ST32CV	14.25
M_ST39CV	M_ST39CV	M_ST39CV	4.28
M_ST40TA	M_ST40TA	M_ST40TA	14.37
M_ST40TS	M_ST40TS	M_ST40TS	1.08
ST3SV	ST3SV	ST3SV	6.66
M_ST32SA	M_ST32SA	M_ST32SA	7.26
M_ST31SA	M_ST31SA	M_ST31SA	5.88
M_ST23CV	M_ST23CV	M_ST23CV	2.67
M_ST60TS	M_ST60TS	M_ST60TS	5.19
ST127SV	ST127SV	ST127SV	5.17
M_ST45TA	M_ST45TA	M_ST45TA	5.98
RD_ST29SV	RD_ST29SV	RD_ST29SV	5.88
RD_ST23TA	RD_ST23TA	RD_ST23TA	1.63
M_ST51TA	M_ST51TA	M_ST51TA	4.57
M_ST60TA	M_ST60TA	M_ST60TA	11.05
M_ST44CV	M_ST44CV	M_ST44CV	10.56
M_ST13TS	M_ST13TS	M_ST13TS	4.04
M_ST24TS	M_ST24TS	M_ST24TS	5.33
RD_ST129SA	RD_ST129SA	RD_ST129SA	1.15
M_ST18SV	M_ST18SV	M_ST18SV	1.41
M_ST13TA	M_ST13TA	M_ST13TA	11.70
M_ST40SA	M_ST40SA	M_ST40SA	6.62
M_ST43TA	M_ST43TA	M_ST43TA	4.04
M_ST31TA	M_ST31TA	M_ST31TA	11.19
M_ST47CV	M_ST47CV	M_ST47CV	3.73
M_ST49TS	M_ST49TS	M_ST49TS	3.02

prBin <- predictionStats_binary(cbind(TADPOLE_DX_NLDE_TEST$DX,predict(bDXmlNLDE,TADPOLE_DX_NLDE_TEST)),"NL vs Dementia")

NL vs Dementia

pander::pander(prBin$aucs)

est	lower	upper
0.939	0.907	0.971

pander::pander(prBin$accc)

est	lower	upper
0.871	0.826	0.908

pander::pander(prBin$berror)

50%	2.5%	97.5%
0.154	0.111	0.203

pander::pander(prBin$sensitivity)

est	lower	upper
0.755	0.658	0.836

par(op)

4.0.3 The formula network

cmax <- apply(bDXmlNLDE$bagging$formulaNetwork,2,max)
cnames <- names(cmax[cmax>=0.25])
cmax <- cmax[cnames]

adma <- bDXmlNLDE$bagging$formulaNetwork[cnames,cnames]

adma[adma<0.15] <- 0;
gr <- graph_from_adjacency_matrix(adma,mode = "undirected",diag = FALSE,weighted=TRUE)
gr$layout <- layout_with_fr

fc <- cluster_optimal(gr)
plot(fc, gr,
     edge.width=10*E(gr)$weight,
     vertex.size=10*cmax,
     vertex.label.cex=0.75,
     vertex.label.dist=0,
     main="NL vs Dementia Diagnosis")

par(op)

4.0.4 NL vs Dementia table

clusterFeatures <- fc$names
sm$coefficients$DeltaAUC <- (sm$coefficients$full.AUC-sm$coefficients$r.AUC)

tableNL_DE <- sm$coefficients[clusterFeatures,
                                   c("Estimate",
                                     "lower",
                                     "OR",
                                     "upper",
                                     "full.AUC",
                                     "DeltaAUC",
                                     "z.IDI",
                                     "Frequency")]

nugget <- fc$membership
names(nugget) <- clusterFeatures

tableNL_DE$Cluster <- nugget[rownames(tableNL_DE)]

rnames <- clusterFeatures[str_detect(clusterFeatures,"ST")]
frnames <- rnames
rnames <- str_replace_all(rnames,"M_","")
rnames <- str_replace_all(rnames,"RD_","")
description <- character()

for (ddet in c(1:length(rnames)))
{
  description <- c(description,TADPOLE_D1_D2_Dict$TEXT[str_detect(TADPOLE_D1_D2_Dict$FLDNAME,rnames[ddet])][1])
}
names(description) <- frnames

tableNL_DE$Description <- description[rownames(tableNL_DE)]
pander::pander(tableNL_DE)

	Estimate	lower	OR	upper	full.AUC	DeltaAUC	z.IDI	Frequency	Cluster	Description
M_ST24TA	-71.833	1.53e-41	6.36e-32	2.64e-22	0.905	0.01339	6.11	1.00	1	Cortical Thickness Average of LeftEntorhinal
Hippocampus	-32.259	4.61e-19	9.78e-15	2.07e-10	0.905	0.03317	5.96	1.00	1	NA
RD_ST32TA	4.598	1.62e+01	9.92e+01	6.07e+02	0.905	0.01967	4.83	1.00	1	Cortical Thickness Average of LeftInferiorTemporal
M_ST24CV	-126.578	6.26e-64	1.07e-55	1.82e-47	0.893	0.06773	10.95	0.90	2	Volume (Cortical Parcellation) of LeftEntorhinal
M_ST36CV	60.045	1.63e+17	1.19e+26	8.77e+34	0.908	0.01951	5.51	1.00	1	Volume (Cortical Parcellation) of LeftLateralOrbitofrontal
M_ST31CV	-26.459	1.68e-16	3.23e-12	6.21e-08	0.908	0.01418	5.16	0.70	1	Volume (Cortical Parcellation) of LeftInferiorParietal
M_ST24SA	27.976	2.30e+07	1.41e+12	8.66e+16	0.893	0.00982	4.84	0.85	2	Surface Area of LeftEntorhinal
M_ST13CV	-18.836	7.01e-13	6.60e-09	6.22e-05	0.892	0.00551	3.94	0.40	2	Volume (Cortical Parcellation) of LeftBankssts
M_ST30SV	18.177	3.65e+04	7.84e+07	1.68e+11	0.888	0.01361	4.50	0.80	2	Volume (WM Parcellation) of LeftInferiorLateralVentricle
M_ST12SV	-70.957	5.93e-38	1.53e-31	3.93e-25	0.888	0.02946	6.60	0.70	3	Volume (WM Parcellation) of LeftAmygdala
M_ST40CV	-13.487	3.87e-09	1.39e-06	4.99e-04	0.888	0.01827	4.38	0.35	2	Volume (Cortical Parcellation) of LeftMiddleTemporal
M_ST32TA	-89.755	7.83e-50	1.05e-39	1.40e-29	0.873	0.03211	5.89	0.35	3	Cortical Thickness Average of LeftInferiorTemporal
RD_ST40TA	4.055	7.48e+00	5.77e+01	4.45e+02	0.878	0.01105	3.74	0.55	2	Cortical Thickness Average of LeftMiddleTemporal
M_ST32CV	-24.079	1.06e-14	3.49e-11	1.14e-07	0.876	0.01922	5.28	0.50	3	Volume (Cortical Parcellation) of LeftInferiorTemporal
M_ST39CV	23.553	1.54e+06	1.69e+10	1.87e+14	0.879	0.01519	4.84	0.55	3	Volume (Cortical Parcellation) of LeftMedialOrbitofrontal
M_ST40TA	-285.718	2.12e-146	8.21e-125	3.18e-103	0.878	0.05294	9.11	0.55	3	Cortical Thickness Average of LeftMiddleTemporal
M_ST40TS	209.499	8.04e+46	9.64e+90	1.16e+135	0.877	0.01558	3.90	0.40	3	Cortical Thickness Standard Deviation of LeftMiddleTemporal
ST3SV	-0.372	5.70e-01	6.90e-01	8.34e-01	0.886	0.00941	3.73	0.50	2	Volume (WM Parcellation) of CorpusCallosumCentral
M_ST60TS	81.273	8.39e+18	1.98e+35	4.67e+51	0.873	0.01193	4.13	0.40	3	Cortical Thickness Standard Deviation of LeftTemporalPole
M_ST45TA	94.898	3.42e+22	1.64e+41	7.82e+59	0.879	0.01132	4.17	0.30	3	Cortical Thickness Average of LeftParsOpercularis
RD_ST29SV	5.102	2.02e+01	1.64e+02	1.34e+03	0.879	0.01484	4.67	0.35	3	Volume (WM Parcellation) of LeftHippocampus
M_ST51TA	62.035	1.28e+17	8.74e+26	5.95e+36	0.875	0.01207	5.12	0.25	2	Cortical Thickness Average of LeftPrecentral
M_ST44CV	-12.899	9.47e-09	2.50e-06	6.60e-04	0.859	0.01061	4.42	0.25	2	Volume (Cortical Parcellation) of LeftParahippocampal

4.1 Decorrelated Set

TADPOLE_DX_NLDE_TRAIND <- GDSTMDecorrelation(TADPOLE_DX_NLDE_TRAIN,Outcome="DX",
                                        thr=0.6,
                                        type="RLM",
                                        method="spearman",
                                        verbose = TRUE)
#> 
#>  Included: 194 , Uni p: 0.01163097 To Outcome: 107 , Base: 4 , In Included: 4 , Base Cor: 10 
#> 1 , Top: 38 < 0.6 >( 1 )[ 1 : 0 : 0.594 ]( 37 , 83 , 0 ),<>Tot Used: 120 , Added: 83 , Zero Std: 0 , Max Cor: 0.9951887 
#> 2 , Top: 23 < 0.6 >( 1 )[ 1 : 0 : 0.594 ]( 22 , 32 , 37 ),<>Tot Used: 142 , Added: 32 , Zero Std: 0 , Max Cor: 0.931277 
#> 3 , Top: 20 < 0.6 >[ FALSE ]( 1 )[ 1 : 0 : 0.594 ]( 20 , 24 , 56 ),<>Tot Used: 153 , Added: 24 , Zero Std: 0 , Max Cor: 0.9073379 
#> 4 , Top: 8 < 0.6 >( 1 )[ 1 : 0 : 0.594 ]( 8 , 11 , 71 ),<>Tot Used: 158 , Added: 11 , Zero Std: 0 , Max Cor: 0.7895856 
#> 5 , Top: 6 < 0.6 >[ FALSE ]( 1 )[ 1 : 0 : 0 ]( 6 , 6 , 77 ),<>Tot Used: 162 , Added: 6 , Zero Std: 0 , Max Cor: 0.5965441 
#> [ 6 ], 0.5942904 . Cor to Base: 89 , ABase: 62
TADPOLE_DX_NLDE_TESTD <-  predictDecorrelate(TADPOLE_DX_NLDE_TRAIND,TADPOLE_DX_NLDE_TEST)

4.1.1 Learning

bDXmlNLDED <- BSWiMS.model(DX~.,TADPOLE_DX_NLDE_TRAIND,NumberofRepeats = 20)

[+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-]..

pander::pander(bDXmlNLDED$bagging$Jaccard.SM)

1

fs <- bDXmlNLDED$bagging$frequencyTable
barplot(fs[order(-fs)],las=2,main="Selected Features",cex.names = 0.5)

sm <- summary(bDXmlNLDED)
pander::pander(sm$coefficients)

	Estimate	lower	OR	upper	u.Accuracy	r.Accuracy	full.Accuracy	u.AUC	r.AUC	full.AUC	IDI	NRI	z.IDI	z.NRI	Frequency
Ba_M_ST24TA	-583	7.02e-290	4.03e-254	2.32e-218	0.850	0.684	0.906	0.843	0.674	0.901	0.4849	1.581	23.03	30.44	1
De_M_ST51TA	1966	Inf	Inf	Inf	0.664	0.870	0.906	0.659	0.867	0.901	0.0922	0.737	7.68	9.36	1
De_Hippocampus	-183	9.92e-103	2.82e-80	8.01e-58	0.595	0.884	0.906	0.592	0.879	0.901	0.0703	0.628	6.58	7.79	1

pander::pander(bDXmlNLDED$univariate[bDXmlNLDED$selectedfeatures,])

	Name	RName	ZUni
Ba_M_ST24TA	Ba_M_ST24TA	Ba_M_ST24TA	19.86
De_Hippocampus	De_Hippocampus	De_Hippocampus	4.99
De_M_ST51TA	De_M_ST51TA	De_M_ST51TA	7.68

prBin <- predictionStats_binary(cbind(TADPOLE_DX_NLDE_TESTD$DX,predict(bDXmlNLDED,TADPOLE_DX_NLDE_TESTD)),"NL vs Dementia")

NL vs Dementia

pander::pander(prBin$aucs)

est	lower	upper
0.933	0.9	0.967

pander::pander(prBin$accc)

est	lower	upper
0.896	0.854	0.929

pander::pander(prBin$berror)

50%	2.5%	97.5%
0.116	0.0798	0.158

pander::pander(prBin$sensitivity)

est	lower	upper
0.837	0.748	0.904

par(op)

4.1.2 The formula network

cmax <- apply(bDXmlNLDED$bagging$formulaNetwork,2,max)
cnames <- names(cmax[cmax>=0.25])
cmax <- cmax[cnames]

adma <- bDXmlNLDED$bagging$formulaNetwork[cnames,cnames]

adma[adma<0.15] <- 0;
gr <- graph_from_adjacency_matrix(adma,mode = "undirected",diag = FALSE,weighted=TRUE)
gr$layout <- layout_with_fr

fc <- cluster_optimal(gr)
plot(fc, gr,
     edge.width=10*E(gr)$weight,
     vertex.size=10*cmax,
     vertex.label.cex=0.75,
     vertex.label.dist=0,
     main="NL vs Dementia Diagnosis")

par(op)

4.1.3 Decorrelated NL vs Dementia table

clusterFeatures <- fc$names
sm$coefficients$DeltaAUC <- (sm$coefficients$full.AUC-sm$coefficients$r.AUC)

tableNL_DED <- sm$coefficients[clusterFeatures,
                                   c("Estimate",
                                     "lower",
                                     "OR",
                                     "upper",
                                     "full.AUC",
                                     "DeltaAUC",
                                     "z.IDI",
                                     "Frequency")]

nugget <- fc$membership
names(nugget) <- clusterFeatures

tableNL_DED$Cluster <- nugget[rownames(tableNL_DED)]

rnames <- clusterFeatures[str_detect(clusterFeatures,"ST")]
frnames <- rnames
rnames <- str_replace_all(rnames,"M_","")
rnames <- str_replace_all(rnames,"RD_","")
rnames <- str_replace_all(rnames,"Ba_","")
rnames <- str_replace_all(rnames,"De_","")
description <- character()

for (ddet in c(1:length(rnames)))
{
  description <- c(description,TADPOLE_D1_D2_Dict$TEXT[str_detect(TADPOLE_D1_D2_Dict$FLDNAME,rnames[ddet])][1])
}
names(description) <- frnames

tableNL_DED$Description <- description[rownames(tableNL_DED)]



## Getting the decorrelation formula
dc <- getDerivedCoefficients(TADPOLE_DX_NLDE_TRAIND)
decornames <- rownames(sm$coefficients)

deNames_in_dc <- decornames[decornames %in% names(dc)]
theDeFormulas <- dc[deNames_in_dc]
deFromula <- character(length(theDeFormulas))
names(deFromula) <- names(theDeFormulas)
for (dx in names(deFromula))
{
  coef <- theDeFormulas[[dx]]
  cname <- names(theDeFormulas[[dx]])
  names(cname) <- cname
  for (cf in names(coef))
  {
    if (cf != dx)
    {
      if (coef[cf]>0)
      {
        deFromula[dx] <- paste(deFromula[dx],
                               sprintf("+ %5.3f*%s",coef[cf],cname[cf]))
      }
      else
      {
        deFromula[dx] <- paste(deFromula[dx],
                               sprintf("%5.3f*%s",coef[cf],cname[cf]))
      }
    }
  }
}

tableNL_DED$DecorFormula <- deFromula[rownames(tableNL_DED)]



pander::pander(tableNL_DED)

	Estimate	lower	OR	upper	full.AUC	DeltaAUC	z.IDI	Frequency	Cluster	Description	DecorFormula
Ba_M_ST24TA	-583	7.02e-290	4.03e-254	2.32e-218	0.901	0.2262	23.03	1	1	Cortical Thickness Average of LeftEntorhinal	NA
De_Hippocampus	-183	9.92e-103	2.82e-80	8.01e-58	0.901	0.0218	6.58	1	1	NA	+ 1.000Hippocampus -1.694M_ST24TA
De_M_ST51TA	1966	Inf	Inf	Inf	0.901	0.0335	7.68	1	1	Cortical Thickness Average of LeftPrecentral	-0.489M_ST31TA + 1.000M_ST51TA + 0.033M_ST51SA -0.138M_ST51CV

5 Prognosis MCI to AD Conversion

5.1 the set

TrainFraction <- 0.60;

MCIPrognosisIDs <- c(MCIconverters$PTID,MCI_No_converters$PTID)

TADPOLECrossMRI <- validBaselineTadpole[MCIPrognosisIDs,]
table(TADPOLECrossMRI$DX)

Dementia MCI NL 0 680 0

TADPOLECrossMRI$DX <- NULL
TADPOLECrossMRI$status <- 1*(rownames(TADPOLECrossMRI) %in% MCIconverters$PTID)
table(TADPOLECrossMRI$status)

0 1 436 244

TADPOLECrossMRI$TimeToEvent <- numeric(nrow(TADPOLECrossMRI))
TADPOLECrossMRI[MCIconverters$PTID,"TimeToEvent"] <- MCIconverters$TimeToEvent
TADPOLECrossMRI[MCI_No_converters$PTID,"TimeToEvent"] <- MCI_No_converters$TimeToEvent

TADPOLE_Cases <- subset(TADPOLECrossMRI,status==1)
TADPOLE_Controls <- subset(TADPOLECrossMRI,status==0)
trainCasesSet <- sample(nrow(TADPOLE_Cases),nrow(TADPOLE_Cases)*TrainFraction)
trainControlSet <- sample(nrow(TADPOLE_Controls),nrow(TADPOLE_Controls)*TrainFraction)

TADPOLE_Conv_TRAIN <- rbind(TADPOLE_Cases[trainCasesSet,],TADPOLE_Controls[trainControlSet,])
TADPOLE_Conv_TEST <- TADPOLECrossMRI[!(rownames(TADPOLECrossMRI) %in%
                                         rownames(TADPOLE_Conv_TRAIN)),]

pander::pander(table(TADPOLE_Conv_TRAIN$status))

0	1
261	146

pander::pander(table(TADPOLE_Conv_TEST$status))

0	1
175	98

par(op)

5.1.1 Learning

bConvml <- BSWiMS.model(Surv(TimeToEvent,status)~1,TADPOLE_Conv_TRAIN,NumberofRepeats = 20)

[++–++-++-++—++-++-++-++—++-++-++-++-++-++-++-++-++-++-+++–++—]….

pander::pander(bConvml$bagging$Jaccard.SM)

0.303

fs <- bConvml$bagging$frequencyTable
barplot(fs[order(-fs)],las=2,main="Selected Features",cex.names = 0.5)

sm <- summary(bConvml)
pander::pander(sm$coefficients)

	Estimate	lower	HR	upper	u.Accuracy	r.Accuracy	full.Accuracy	u.AUC	r.AUC	full.AUC	IDI	NRI	z.IDI	z.NRI	Frequency
FAQ	0.05263	1.04e+00	1.05e+00	1.07e+00	0.727	0.747	0.773	0.691	0.754	0.776	0.04434	0.566	6.47	7.12	1.00
ADAS13	0.05239	1.04e+00	1.05e+00	1.07e+00	0.710	0.763	0.773	0.709	0.765	0.776	0.04892	0.469	5.95	5.56	1.00
M_ST12SV	-28.54614	2.77e-17	4.00e-13	5.78e-09	0.716	0.746	0.764	0.713	0.748	0.769	0.02954	0.492	5.53	5.85	1.00
ADAS11	0.04839	1.03e+00	1.05e+00	1.07e+00	0.688	0.720	0.751	0.679	0.729	0.756	0.04085	0.449	5.42	5.34	1.00
RAVLT_perc_forgetting	0.00478	1.00e+00	1.00e+00	1.01e+00	0.658	0.760	0.754	0.664	0.759	0.757	0.02945	0.447	4.78	5.27	0.90
M_ST29SV	-14.56677	1.62e-09	4.72e-07	1.38e-04	0.707	0.746	0.755	0.704	0.748	0.758	0.01957	0.320	4.36	3.74	0.85
RD_ST31TA	2.30138	3.62e+00	9.99e+00	2.76e+01	0.613	0.772	0.773	0.587	0.776	0.777	0.01551	0.373	4.36	4.42	0.65
M_ST40CV	-11.34356	7.50e-08	1.18e-05	1.87e-03	0.711	0.748	0.758	0.702	0.751	0.761	0.01683	0.306	4.29	3.56	0.95
M_ST40SA	-1.03616	2.24e-01	3.55e-01	5.63e-01	0.655	0.739	0.750	0.650	0.745	0.756	0.01636	0.358	4.27	4.18	0.20
RAVLT_immediate	-0.01992	9.72e-01	9.80e-01	9.89e-01	0.655	0.769	0.765	0.672	0.770	0.771	0.02467	0.426	4.19	5.02	1.00
RD_ST49SA	-1.91809	5.61e-02	1.47e-01	3.85e-01	0.500	0.751	0.752	0.521	0.756	0.758	0.01281	0.242	3.73	2.85	0.70
M_ST44TS	17.15271	5.00e+03	2.81e+07	1.58e+11	0.548	0.752	0.759	0.553	0.761	0.770	0.01408	0.364	3.67	4.28	0.15
M_ST14TS	5.16485	8.09e+00	1.75e+02	3.79e+03	0.606	0.747	0.746	0.595	0.749	0.748	0.00897	0.238	3.23	2.75	0.10

pander::pander(bConvml$univariate[bConvml$selectedfeatures,])

	Name	RName	ZUni
ADAS13	ADAS13	ADAS13	11.37
FAQ	FAQ	FAQ	8.88
M_ST39SA	M_ST39SA	M_ST39SA	6.29
M_ST12SV	M_ST12SV	M_ST12SV	10.17
RD_ST31TA	RD_ST31TA	RD_ST31TA	3.78
RAVLT_immediate	RAVLT_immediate	RAVLT_immediate	8.89
ADAS11	ADAS11	ADAS11	9.90
M_ST56SA	M_ST56SA	M_ST56SA	4.74
M_ST29SV	M_ST29SV	M_ST29SV	9.88
M_ST40CV	M_ST40CV	M_ST40CV	9.70
RAVLT_perc_forgetting	RAVLT_perc_forgetting	RAVLT_perc_forgetting	7.89
M_ST14TS	M_ST14TS	M_ST14TS	5.30
M_ST59SA	M_ST59SA	M_ST59SA	3.64
M_ST59CV	M_ST59CV	M_ST59CV	7.06
M_ST40SA	M_ST40SA	M_ST40SA	6.75
RD_ST49TA	RD_ST49TA	RD_ST49TA	2.08
RD_ST49SA	RD_ST49SA	RD_ST49SA	2.15
RAVLT_learning	RAVLT_learning	RAVLT_learning	6.31
M_ST44TS	M_ST44TS	M_ST44TS	2.45

ptestl <- predict(bConvml,TADPOLE_Conv_TEST,type="lp")
boxplot(ptestl~TADPOLE_Conv_TEST$status)

ptestr <- predict(bConvml,TADPOLE_Conv_TEST,type="risk")
eventCases <- subset(TADPOLE_Conv_TEST,status==1)
plot(1.0/ptestr[rownames(eventCases)]~eventCases$TimeToEvent)

pander::pander(cor.test(eventCases$TimeToEvent,1.0/ptestr[rownames(eventCases)],method="spearman"))

Spearman’s rank correlation rho: eventCases$TimeToEvent and 1/ptestr[rownames(eventCases)]

Test statistic	P value	Alternative hypothesis	rho
104589	0.000801 * * *	two.sided	0.333

perdsurv <- cbind(TADPOLE_Conv_TEST$TimeToEvent,
                  TADPOLE_Conv_TEST$status,
                  ptestl,
                  ptestr)
prSurv <- predictionStats_survival(perdsurv,"MCI to  AD Conversion")

pander::pander(prSurv$CIRisk)

median	lower	upper
0.818	0.775	0.858

pander::pander(prSurv$CILp)

median	lower	upper
0.837	0.786	0.882

pander::pander(prSurv$spearmanCI)

50%	2.5%	97.5%
0.336	0.127	0.517

prBin <- predictionStats_binary(cbind(TADPOLE_Conv_TEST$status,ptestl),"MCI to  AD Conversion")

MCI to AD Conversion

pander::pander(prBin$aucs)

est	lower	upper
0.836	0.787	0.885

pander::pander(prBin$CM.analysis$tab)

	Outcome +	Outcome -	Total
Test +	78	48	126
Test -	20	127	147
Total	98	175	273

par(op)

5.1.2 The formula network

cmax <- apply(bConvml$bagging$formulaNetwork,2,max)
cnames <- names(cmax[cmax>=0.25])
cmax <- cmax[cnames]

adma <- bConvml$bagging$formulaNetwork[cnames,cnames]

adma[adma<0.15] <- 0;
gr <- graph_from_adjacency_matrix(adma,mode = "undirected",diag = FALSE,weighted=TRUE)
gr$layout <- layout_with_fr

fc <- cluster_optimal(gr)
plot(fc, gr,
     edge.width=5*E(gr)$weight,
     vertex.size=20*cmax,
     vertex.label.cex=0.75,
     vertex.label.dist=0,
     main="MCI to Dementia Conversion")

par(op)

5.1.3 MCI to Dementia table

clusterFeatures <- fc$names
sm$coefficients$DeltaAUC <- (sm$coefficients$full.AUC-sm$coefficients$r.AUC)

tableMCI_to_Dem <- sm$coefficients[clusterFeatures,
                                   c("Estimate",
                                     "lower",
                                     "HR",
                                     "upper",
                                     "full.AUC",
                                     "DeltaAUC",
                                     "z.IDI",
                                     "Frequency")]

nugget <- fc$membership
names(nugget) <- clusterFeatures

tableMCI_to_Dem$Cluster <- nugget[rownames(tableMCI_to_Dem)]

rnames <- clusterFeatures[str_detect(clusterFeatures,"ST")]
frnames <- rnames
rnames <- str_replace_all(rnames,"M_","")
rnames <- str_replace_all(rnames,"RD_","")
rnames <- str_replace_all(rnames,"Ba_","")
rnames <- str_replace_all(rnames,"De_","")
description <- character()

for (ddet in c(1:length(rnames)))
{
  description <- c(description,TADPOLE_D1_D2_Dict$TEXT[str_detect(TADPOLE_D1_D2_Dict$FLDNAME,rnames[ddet])][1])
}
names(description) <- frnames

tableMCI_to_Dem$Description <- description[rownames(tableMCI_to_Dem)]
pander::pander(tableMCI_to_Dem)

	Estimate	lower	HR	upper	full.AUC	DeltaAUC	z.IDI	Frequency	Cluster	Description
ADAS13	0.05239	1.04e+00	1.05e+00	1.07e+00	0.776	0.01097	5.95	1.00	1	NA
FAQ	0.05263	1.04e+00	1.05e+00	1.07e+00	0.776	0.02207	6.47	1.00	1	NA
M_ST12SV	-28.54614	2.77e-17	4.00e-13	5.78e-09	0.769	0.02173	5.53	1.00	1	Volume (WM Parcellation) of LeftAmygdala
RD_ST31TA	2.30138	3.62e+00	9.99e+00	2.76e+01	0.777	0.00118	4.36	0.65	1	Cortical Thickness Average of LeftInferiorParietal
RAVLT_immediate	-0.01992	9.72e-01	9.80e-01	9.89e-01	0.771	0.00118	4.19	1.00	1	NA
ADAS11	0.04839	1.03e+00	1.05e+00	1.07e+00	0.756	0.02717	5.42	1.00	2	NA
M_ST29SV	-14.56677	1.62e-09	4.72e-07	1.38e-04	0.758	0.01044	4.36	0.85	2	Volume (WM Parcellation) of LeftHippocampus
M_ST40CV	-11.34356	7.50e-08	1.18e-05	1.87e-03	0.761	0.00994	4.29	0.95	2	Volume (Cortical Parcellation) of LeftMiddleTemporal
RAVLT_perc_forgetting	0.00478	1.00e+00	1.00e+00	1.01e+00	0.757	-0.00197	4.78	0.90	2	NA
RD_ST49SA	-1.91809	5.61e-02	1.47e-01	3.85e-01	0.758	0.00180	3.73	0.70	2	Surface Area of LeftPostcentral

5.2 Decorrelated

TADPOLE_Conv_TRAIND <- GDSTMDecorrelation(TADPOLE_Conv_TRAIN,
                                          Outcome="status",
                                          thr=0.6,
                                          type="RLM",
                                          method="spearman",
                                          verbose = TRUE)
#> 
#>  Included: 209 , Uni p: 0.01153193 To Outcome: 122 , Base: 4 , In Included: 4 , Base Cor: 3 
#> 1 , Top: 44 < 0.6 >( 2 )[ 1 : 0 : 0.594 ]( 43 , 88 , 0 ),<>Tot Used: 131 , Added: 88 , Zero Std: 0 , Max Cor: 0.991806 
#> 2 , Top: 30 < 0.6 >( 1 )[ 1 : 0 : 0.594 ]( 28 , 52 , 43 ),<>Tot Used: 172 , Added: 52 , Zero Std: 0 , Max Cor: 0.903256 
#> 3 , Top: 22 < 0.6 >[ TRUE ]( 1 )[ 1 : 0 : 0.594 ]( 22 , 25 , 66 ),<>Tot Used: 174 , Added: 25 , Zero Std: 0 , Max Cor: 0.9184848 
#> 4 , Top: 10 < 0.6 >[ FALSE ]( 1 )[ 1 : 0 : 0 ]( 10 , 10 , 82 ),<>Tot Used: 175 , Added: 10 , Zero Std: 0 , Max Cor: 0.605463 
#> 5 , Top: 1 < 0.6 >( 1 )[ 1 : 0 : 0.6 ]( 1 , 1 , 90 ),<>Tot Used: 175 , Added: 1 , Zero Std: 0 , Max Cor: 0.6266446 
#> 6 , Top: 1 < 0.6 >( 1 )[ 1 : 0 : 0.6 ]( 1 , 1 , 90 ),<>Tot Used: 175 , Added: 1 , Zero Std: 0 , Max Cor: 0.599695 
#> [ 7 ], 0.5951033 . Cor to Base: 98 , ABase: 77
TADPOLE_Conv_TESTD <-  predictDecorrelate(TADPOLE_Conv_TRAIND,TADPOLE_Conv_TEST)

5.2.1 Learning

bConvmlD <- BSWiMS.model(Surv(TimeToEvent,status)~1,TADPOLE_Conv_TRAIND,NumberofRepeats = 20)

[+-++-++-++-+-++-+-++-++-+–++-++-+–++-+-+-++-+-++-+–]…

pander::pander(bConvmlD$bagging$Jaccard.SM)

0.373

fs <- bConvmlD$bagging$frequencyTable
barplot(fs[order(-fs)],las=2,main="Selected Features",cex.names = 0.5)

sm <- summary(bConvmlD)
pander::pander(sm$coefficients)

	Estimate	lower	HR	upper	u.Accuracy	r.Accuracy	full.Accuracy	u.AUC	r.AUC	full.AUC	IDI	NRI	z.IDI	z.NRI	Frequency
Ba_ADAS13	0.08875	1.07e+00	1.09e+00	1.11e+00	0.711	0.773	0.780	0.709	0.771	0.782	0.08488	0.622	7.96	7.53	1.00
FAQ	0.07336	1.06e+00	1.08e+00	1.09e+00	0.726	0.749	0.780	0.688	0.754	0.782	0.05194	0.644	7.23	8.15	1.00
Ba_RAVLT_learning	-0.05361	9.32e-01	9.48e-01	9.64e-01	0.655	0.717	0.754	0.665	0.713	0.745	0.05653	0.529	5.88	6.37	0.55
De_M_ST40SA	-4.45130	2.40e-03	1.17e-02	5.66e-02	0.654	0.720	0.754	0.647	0.712	0.745	0.03724	0.433	5.46	5.09	0.55
De_M_ST32TA	-77.26965	1.84e-46	2.77e-34	4.16e-22	0.581	0.743	0.754	0.578	0.729	0.745	0.03777	0.511	5.32	6.07	0.55
De_Hippocampus	-23.08759	1.15e-14	9.40e-11	7.71e-07	0.699	0.775	0.780	0.698	0.771	0.782	0.02369	0.438	4.92	5.16	1.00
Ba_RD_ST49SA	-2.47656	3.00e-02	8.40e-02	2.35e-01	0.504	0.742	0.754	0.527	0.731	0.745	0.02185	0.312	4.62	3.68	0.55
De_RAVLT_perc_forgetting	0.00748	1.00e+00	1.01e+00	1.01e+00	0.597	0.731	0.754	0.591	0.732	0.745	0.03335	0.363	4.52	4.24	0.55
RD_ST31TA	3.44686	7.26e+00	3.14e+01	1.36e+02	0.616	0.777	0.781	0.588	0.779	0.781	0.01726	0.379	4.52	4.52	0.75
De_M_ST60SA	-1.30154	1.51e-01	2.72e-01	4.91e-01	0.606	0.752	0.753	0.605	0.741	0.742	0.01629	0.379	4.22	4.43	0.15
RD_ST65SV	-3.93478	3.14e-03	1.95e-02	1.22e-01	0.521	0.766	0.778	0.539	0.771	0.783	0.01668	0.357	4.09	4.19	0.25
De_M_ST48CV	-34.43520	1.16e-22	1.11e-15	1.06e-08	0.563	0.774	0.779	0.558	0.774	0.779	0.01046	0.220	4.07	2.56	0.75
Ba_M_ST56SA	-1.18349	1.70e-01	3.06e-01	5.53e-01	0.571	0.770	0.784	0.576	0.776	0.790	0.01844	0.251	3.84	2.91	0.15
De_RAVLT_immediate	-0.01446	9.78e-01	9.86e-01	9.93e-01	0.542	0.788	0.776	0.546	0.786	0.780	0.02017	0.428	3.77	5.03	0.40
RD_ST59TA	0.37117	1.17e+00	1.45e+00	1.79e+00	0.559	0.757	0.753	0.536	0.750	0.746	0.00971	0.242	3.25	2.84	0.15
Ba_M_ST129SA	-1.13376	1.67e-01	3.22e-01	6.19e-01	0.625	0.750	0.754	0.630	0.745	0.746	0.01143	0.237	3.04	2.75	0.30

pander::pander(bConvmlD$univariate[bConvmlD$selectedfeatures,])

	Name	RName	ZUni
Ba_ADAS13	Ba_ADAS13	Ba_ADAS13	11.37
FAQ	FAQ	FAQ	8.88
De_Hippocampus	De_Hippocampus	De_Hippocampus	9.53
RD_ST31TA	RD_ST31TA	RD_ST31TA	3.78
RD_ST65SV	RD_ST65SV	RD_ST65SV	2.04
De_M_ST51CV	De_M_ST51CV	De_M_ST51CV	2.19
De_RAVLT_immediate	De_RAVLT_immediate	De_RAVLT_immediate	1.47
De_M_ST48CV	De_M_ST48CV	De_M_ST48CV	3.56
Ba_M_ST56SA	Ba_M_ST56SA	Ba_M_ST56SA	4.74
De_M_ST12SV	De_M_ST12SV	De_M_ST12SV	3.60
Gender	Gender	Gender	1.56
Ba_RAVLT_learning	Ba_RAVLT_learning	Ba_RAVLT_learning	6.31
De_M_ST40SA	De_M_ST40SA	De_M_ST40SA	6.75
De_M_ST32TA	De_M_ST32TA	De_M_ST32TA	3.27
Ba_M_ST129SA	Ba_M_ST129SA	Ba_M_ST129SA	6.25
M_ST49CV	M_ST49CV	M_ST49CV	5.60
Ba_RAVLT_forgetting	Ba_RAVLT_forgetting	Ba_RAVLT_forgetting	2.93
De_RAVLT_perc_forgetting	De_RAVLT_perc_forgetting	De_RAVLT_perc_forgetting	4.94
Ba_RD_ST49SA	Ba_RD_ST49SA	Ba_RD_ST49SA	2.15
De_M_ST60SA	De_M_ST60SA	De_M_ST60SA	5.34
RD_ST59TA	RD_ST59TA	RD_ST59TA	2.24

ptestl <- predict(bConvmlD,TADPOLE_Conv_TESTD,type="lp")
boxplot(ptestl~TADPOLE_Conv_TEST$status)

ptestr <- predict(bConvmlD,TADPOLE_Conv_TESTD,type="risk")
eventCases <- subset(TADPOLE_Conv_TEST,status==1)
plot(1.0/ptestr[rownames(eventCases)]~eventCases$TimeToEvent)

pander::pander(cor.test(eventCases$TimeToEvent,1.0/ptestr[rownames(eventCases)],method="spearman"))

Spearman’s rank correlation rho: eventCases$TimeToEvent and 1/ptestr[rownames(eventCases)]

Test statistic	P value	Alternative hypothesis	rho
98622	0.000168 * * *	two.sided	0.371

perdsurv <- cbind(TADPOLE_Conv_TEST$TimeToEvent,
                  TADPOLE_Conv_TEST$status,
                  ptestl,
                  ptestr)
prSurv <- predictionStats_survival(perdsurv,"MCI to  AD Conversion")

pander::pander(prSurv$CIRisk)

median	lower	upper
0.82	0.777	0.861

pander::pander(prSurv$CILp)

median	lower	upper
0.838	0.791	0.884

pander::pander(prSurv$spearmanCI)

50%	2.5%	97.5%
0.371	0.182	0.538

prBin <- predictionStats_binary(cbind(TADPOLE_Conv_TESTD$status,ptestl),"MCI to  AD Conversion")

MCI to AD Conversion

pander::pander(prBin$aucs)

est	lower	upper
0.837	0.789	0.886

pander::pander(prBin$CM.analysis$tab)

	Outcome +	Outcome -	Total
Test +	75	43	118
Test -	23	132	155
Total	98	175	273

par(op)

5.2.2 The formula network

cmax <- apply(bConvmlD$bagging$formulaNetwork,2,max)
cnames <- names(cmax[cmax>=0.25])
cmax <- cmax[cnames]

adma <- bConvmlD$bagging$formulaNetwork[cnames,cnames]

adma[adma<0.15] <- 0;
gr <- graph_from_adjacency_matrix(adma,mode = "undirected",diag = FALSE,weighted=TRUE)
gr$layout <- layout_with_fr

fc <- cluster_optimal(gr)
plot(fc, gr,
     edge.width=5*E(gr)$weight,
     vertex.size=20*cmax,
     vertex.label.cex=0.75,
     vertex.label.dist=0,
     main="MCI to Dementia Conversion")

par(op)

5.2.3 Decorrelated MCI to Dementia table

clusterFeatures <- fc$names
sm$coefficients$DeltaAUC <- (sm$coefficients$full.AUC-sm$coefficients$r.AUC)

tableMCI_to_DemD <- sm$coefficients[clusterFeatures,
                                   c("Estimate",
                                     "lower",
                                     "HR",
                                     "upper",
                                     "full.AUC",
                                     "DeltaAUC",
                                     "z.IDI",
                                     "Frequency")]

nugget <- fc$membership
names(nugget) <- clusterFeatures

tableMCI_to_DemD$Cluster <- nugget[rownames(tableMCI_to_DemD)]

rnames <- clusterFeatures[str_detect(clusterFeatures,"ST")]
frnames <- rnames
rnames <- str_replace_all(rnames,"M_","")
rnames <- str_replace_all(rnames,"RD_","")
rnames <- str_replace_all(rnames,"Ba_","")
rnames <- str_replace_all(rnames,"De_","")
description <- character()

for (ddet in c(1:length(rnames)))
{
  description <- c(description,TADPOLE_D1_D2_Dict$TEXT[str_detect(TADPOLE_D1_D2_Dict$FLDNAME,rnames[ddet])][1])
}
names(description) <- frnames

tableMCI_to_DemD$Description <- description[rownames(tableMCI_to_DemD)]


## Getting the decorrelation formula
dc <- getDerivedCoefficients(TADPOLE_Conv_TRAIND)
decornames <- rownames(sm$coefficients)

deNames_in_dc <- decornames[decornames %in% names(dc)]
theDeFormulas <- dc[deNames_in_dc]
deFromula <- character(length(theDeFormulas))
names(deFromula) <- names(theDeFormulas)
for (dx in names(deFromula))
{
  coef <- theDeFormulas[[dx]]
  cname <- names(theDeFormulas[[dx]])
  names(cname) <- cname
  for (cf in names(coef))
  {
    if (cf != dx)
    {
      if (coef[cf]>0)
      {
        deFromula[dx] <- paste(deFromula[dx],
                               sprintf("+ %5.3f*%s",coef[cf],cname[cf]))
      }
      else
      {
        deFromula[dx] <- paste(deFromula[dx],
                               sprintf("%5.3f*%s",coef[cf],cname[cf]))
      }
    }
  }
}

tableMCI_to_DemD$DecorFormula <- deFromula[rownames(tableMCI_to_DemD)]


pander::pander(tableMCI_to_DemD)

	Estimate	lower	HR	upper	full.AUC	DeltaAUC	z.IDI	Frequency	Cluster	Description	DecorFormula
Ba_ADAS13	0.08875	1.07e+00	1.09e+00	1.11e+00	0.782	0.01103	7.96	1.00	1	NA	NA
FAQ	0.07336	1.06e+00	1.08e+00	1.09e+00	0.782	0.02759	7.23	1.00	1	NA	NA
De_Hippocampus	-23.08759	1.15e-14	9.40e-11	7.71e-07	0.782	0.01098	4.92	1.00	1	NA	NA
RD_ST31TA	3.44686	7.26e+00	3.14e+01	1.36e+02	0.781	0.00238	4.52	0.75	1	Cortical Thickness Average of LeftInferiorParietal	NA
RD_ST65SV	-3.93478	3.14e-03	1.95e-02	1.22e-01	0.783	0.01113	4.09	0.25	1	Volume (WM Parcellation) of LeftVentralDC	NA
De_RAVLT_immediate	-0.01446	9.78e-01	9.86e-01	9.93e-01	0.780	-0.00607	3.77	0.40	1	NA	+ 1.036ADAS13 + 1.000RAVLT_immediate
De_M_ST48CV	-34.43520	1.16e-22	1.11e-15	1.06e-08	0.779	0.00527	4.07	0.75	1	Volume (Cortical Parcellation) of LeftPericalcarine	-5.634M_ST48TS -0.233M_ST48SA + 1.000*M_ST48CV
Ba_RAVLT_learning	-0.05361	9.32e-01	9.48e-01	9.64e-01	0.745	0.03191	5.88	0.55	2	NA	NA
De_M_ST40SA	-4.45130	2.40e-03	1.17e-02	5.66e-02	0.745	0.03297	5.46	0.55	2	Surface Area of LeftMiddleTemporal	NA
De_M_ST32TA	-77.26965	1.84e-46	2.77e-34	4.16e-22	0.745	0.01654	5.32	0.55	2	Cortical Thickness Average of LeftInferiorTemporal	+ 1.000M_ST32TA -0.810M_ST59TA
Ba_M_ST129SA	-1.13376	1.67e-01	3.22e-01	6.19e-01	0.746	0.00160	3.04	0.30	2	Surface Area of LeftInsula	NA
De_RAVLT_perc_forgetting	0.00748	1.00e+00	1.01e+00	1.01e+00	0.745	0.01388	4.52	0.55	2	NA	+ 5.300RAVLT_learning -11.044RAVLT_forgetting + 1.000*RAVLT_perc_forgetting
Ba_RD_ST49SA	-2.47656	3.00e-02	8.40e-02	2.35e-01	0.745	0.01482	4.62	0.55	2	Surface Area of LeftPostcentral	NA

5.2.4 Saving the enviroment

save.image("~/GitHub/BSWiMS/TADPOLE_BSWIMS_Results.RData")